perm filename SOS.FAI[2,LCS] blob
sn#028059 filedate 1975-04-18 generic text, type T, neo UTF8
TITLE SOS SON OF STOPGAP
IFNDEF TWOSGM,<↓TWOSGM←←1> ;DEFAULT TO TWO SEGMENTS.
SUBTTL DEFINITIONS
;TEMPORARY EDITOR FOR THE DISK--WORKS BY RECOPYING
;DEVICES USED
OPDEF TTYUUO [51B8]
OPDEF SLEEP [CALLI 31]
OPDEF GETPPN [CALLI 24]
OPDEF DATE [CALLI 14]
OPDEF TIMER [CALLI 22]
OPDEF MAIL [710B8]
OPDEF SEND [MAIL]
OPDEF PTYUUO [711B8]
OPDEF PTYGET [PTYUUO 0,]
OPDEF PTIFRE [PTYUUO 2,]
OPDEF PTWR1W [PTYUUO 7,]
OPDEF PTWRS7 [PTYUUO 11,]
OPDEF PTRD1W [PTYUUO 5,]
OPDEF PTYREL [PTYUUO 1,]
OPDEF JBTSTS [CALLI 400013]
IFNDEF TWOSGM,{↓TWOSGM←0}
↓STANSW←←1 ;ON FOR STANFORD TYPE PPNS, ETC
↓FULDPX←←1 ;FULL DUPLEX SCANNER
↓TTY←←1
↓IN←←2
↓OUT←←3
↓LPT←←4
↓ALTDV←←5 ;THE OTHER INPUT DEVICE (COPY AND TRANSFER)
;ACS USED
↓FL←10 ;FLAG REGISTER
↓T1←1 ;TEMP REGISTERS
↓T2←2
↓T3←3
↓T4←4
↓T5←5
↓FL2←11
↓ALTP←12 ;POINTER FOR ALTER MODE
↓CS←13 ;CHARACTER TABLE BITS
↓SINDEX←14 ;LINE TO FIND, USED ALSO BY THE VARIOUS ROUTINES
↓PNTR←15 ;POINTS AT CURRENT PLACE IN BUFFER
↓C←16 ;CHARACTER RETURNED HERE BY GNCH
↓P←17 ;PUSHDOWN LIST
;FLAGS (RIGHT HALF)
BOF←←1 ;NOW ON FIRST RECORD OF FILE
EOF←←2 ;HAVE READ END OF FILE BUT NOT NECESSARILY BUT IN BUFFER
EOF2←←4 ;LAST WORD OF FILE IS IN CURRENT BUFFER
ADDL←←10 ;USED IN COMMAND SCANNING--LINE NUMBER + INC
SUBL←←20 ;LINE NUMBER - INC
IDF←←40 ;SCAN HAS SEEN AN IDENTIFIER
NUMF←←100 ;SCAN HAS SEEN A NUMBER
TERMF←←200 ;SCAN SAW A TERMINATOR (LF OR ALTMODE)
LINSN←←400 ;THE COMMAND INPUT ROUTINES SAW A LINE NUMBER
PGSN←←1000 ;THEY SAW A PAGE NUMBER
NEWFL←←2000 ;NEW FILE NAME SEEN BY END CODE
ORDF←←4000 ;LINES OUT OF ORDER (USED BY NUMBER)
BGSN←←10000 ;BIGGEST PAGE HAS BEEN SEEN
M37F←←20000 ;THIS IS A MODEL 37
CNTF←←40000 ;COMMAND USING !
DPYF←←100000 ;THIS IS A III DISPLAY
READOF←←200000 ;THIS FILE IS BEING USED IN READ ONLY MODE
EXTOG←←400000 ;ON FOR SHORT ERROR MESSAGES
;FLAGS (LEFT HALF)
NEGF←←1 ;SEARCH HAS SEEN A ¬
DEMCHR←←2 ;SEARCH MUST SEE ANOTHER CHARACTER
ASSMF←←4 ;SEARCH HAS ASSUMED SEARCH CONTINUATION
ALTSRF←←10 ;HE WANTS TO DO A SEARCH AND EDIT
NUMSRF←←20 ;HE ONLY WANTS NUMBERS OF LINES FOUND
ARBITG←←40 ;WE ARE DOING ∞ CURRENTLY, DO NOT ALLOW ANOTHER
EXCTSR←←100 ;WANTS TO SEARCH EXACTLY (NOT IGNORE CASE)
COPFIL←←200 ;WE ARE COPYING FROM ANOTHER FILE
ISCOP←←400 ;WE ARE DOING A COPY
NOPRN←←1000 ;DO NOT PRINT WHILE DOING SUBSTITUTE
DECID←←2000 ;ALLOW USER TO DECIDE IF LINE IS OK
EXCTS1←←4000 ;ANOTHER EXACT SEARCH FLAG FOR SUBS
QMODF←←10000 ;DO NOT TREAT ? AS A SPECIAL CASE ON INPUT
GCOM←←20000 ;DOING A G COMMAND INSTEAD OF E
SRCOP←←40000 ;DOING A SEARCH OF SECOND FILE
TRANFL←←100000 ;THIS IS A TRANSFER COMMAND WHICH HAS DELETED LINES
TECOF←←200000 ;THIS IS A TECO FILE
FSTOPF←←400000 ;THIS IS THE FIRST READ OP ON THIS FILE
;FLAGS IN FL2 (RIGHT)
STARF←←1 ;WE HAVE SEEN A * FOR THE LAST LINE
RUBF←←2 ;WE ARE DOING RUBOUT IN INTRA-LINE EDIT
ALTDUP←←4 ;DUPLEX CHARACTERS IN ALTER MODE
RUBF2←←10 ;DOING DELETE TYPE RUBOUT IN ALTER MODE
SVIT←←20 ;WE ARE DOING A "W" COMMAND (SAVE WORLD)
JFFLG←←40 ;J DOES FILL ONLY
JRFLG←←100 ;J DOES RIGHT JUSTIFY
JCFLG←←200 ;J DOES CENTERING
JBLF←←400 ;J SEES A BLANK
SUPN←←1000 ;SUPPRESS LISTING OF LINE NUMBERS
JLFLG←←2000 ;J DOES LEFT JUSTIFY
JPER←←4000 ;J SEES A PERIOD OR SOMETHING LIKE IT
ZSRF←←10000 ;,Z IN SEARCH (ANALOGUE TO ,A -- SEE ALTSRF BIT)
ZSPA←←20000 ;TELLS ZLIN ROUTINE TO SPACE OUT
;BOTH THESE BITS SHOULD BE IN LH OF FL, BUT...
EXTERNAL JOBFF,JOBREL,JOBSYM,JOBDDT,JOBAPR,JOBSA,JOBOPC
OPDEF ERROR [1B8] ;ERROR UUOS FATAL ERROR
OPDEF NERROR [2B8] ;NON-FATAL ERROR
OPDEF RERROR [3B8] ;PRINT MESSAGE AND RETURN
;ERROR NUMBERS
ICN←←1 ;INTERNAL EDITOR CONFUSION
DIE←←2 ;DEVICE INPUT ERROR
DDE←←3 ;DEVICE OUTPUT ERROR
ILC←←4 ;ILLEGAL COMMAND
ILUUO←←5 ;PROTECTION. SOMEONE EXECUTED AN ILLEGAL UUO
LTL←←6 ;LINE IS TOO LOGNNG
NLN←←7 ;NULL COMAND RANGE
NSP←←10 ;NO SUCH PAGE (DELETE)
ORDER←←11 ;LINES OUT OF ORDER
UNA←←12 ;LPT NOT AVAILABLE FOR L COMMAND
ILR←←13 ;ILLEGAL REPLACEMENT WITH INSERT
WAR←←14 ;WRAP AROUND IN RENUMBERING
TMS←←15 ; TOO MANY SEARCH STRINGS GIVEN
STL←←16 ;TOO MANY TOTAL STRING CHRS
ISS←←17 ;ILLEGAL SEARCH STRING
ILFMT←←20 ;ILLEGAL LINE FORMAT DETECTED
NSG←←21 ;NO STRING GIVEN
FNF←←22 ;FILE NOT FOUND (COPY)
DNA←←23 ;DISK NOT AVAILABLE (COPY)
NEC←←24 ;NOT ENOUGH CORE (COPY)
IRS←←25 ;ILLEGAL REPLACEMENT STRING
STC←←26 ;SEARCH STRING TOO COMPLEX (GOT PDLOV)
ITD←←27 ;ILLEGAL TRANSFER DESTINATION (PLACE NO LONGER THERE)
NNN←←30 ;NO NEXT LINE (FROM JOIN TYPE COMMANDS)
BKO←←31 ;BREAK OUT BY ↑C-REENTER IF POSSIBLE
↓SRBLG←←=200 ;NUMBER OF CHRS ALLOWED IN SEARCH STRING
↓SRNUM←←6 ;NUMBER OF SEARCH STRINGS ALLOWED
↓PDLSIZ←←200 ;PUSHDOWN LIST SIZE
↓MXWPL←←=30 ;MAX NUMBER OF WORDS PER LINE
↓LSNUM←←3 ;NUMBER OF NESTED LINE SEARCHES ALLOWED
IFN STANSW,<%LPP←←=52>
IFE STANSW,<%LPP←←=58>
DEFINE IFEDUPL {IFE FULDPX, } ;MAKE CONDIT ASSEMBLIES EASIER
DEFINE ELSE {IFN FULDPX, }
DEFINE TERPRI (AC) {
IFEDUPL {MOVEI AC,[BYTE (7) 15,12]
CALLI AC,3 ;PRINT CR-LF
;} TTYUUO 3,[BYTE (7) 15,12]
}
DEFINE MSSG (AC,MX) {
IFEDUPL {MOVEI AC,[ASCIZ /MX/]
CALLI AC,3 ;} TTYUUO 3,[ASCIZ /MX/]
}
DEFINE MSG (AC,MX) {
IFEDUPL {MOVEI AC,[ASCIZ /
MX
/]
CALLI AC,3
} ELSE {TTYUUO 3,[ASCIZ /
MX
/]}
}
DEFINE MSGSTR (AC,MX) {
IFEDUPL {MOVEI AC,[ASCIZ /
MX
*/]
CALLI AC,3
} ELSE {TTYUUO 3,[ASCIZ /
MX
*/]}
}
; PRINT A MESSAGE -- GET A CHARACTER IN REPLY
DEFINE GTNS(MSG) <
IFE FULDPX ,<
MOVEI T1,[ASCIZ /MSG/]
CALLI T1,3
MOVEI T1,DDTINB
CALLI T1,1
LDB T1,[POINT 7,DDTINB,6]
>
IFN FULDPX,<
TTYUUO 3,[ASCIZ /MSG/]
TTYUUO T1
>
>
SUBTTL DATA AREA -- LOWER SEGMENT
Comment ⊗ DCS Here is all the data in the world, so arranged
as to be a template for the upper segment, the data for
the lower segment, and an example to the world. ⊗
DEFINE IFB (X) {IFIDN {X⎇{⎇ ⎇
DEFINE IFNB (X) {IFDIF {X⎇{⎇⎇
DEFINE DATA(WHAT,HOWM,STUFF) {
IFNB (WHAT) , {WHAT:⎇
IFNB (HOWM) , {HOWMANY←←HOWM;⎇ HOWMANY←←1
IFNB (STUFF), {STUFF;⎇ BLOCK HOWMANY
}
DATA (SCRUP1)
DATA (SCRUP2)
DATA (ACCUM) ;ACCUMULATE 6-BIT IN SCANNER
DATA (ALTBF,3)
DATA (ALTCNT) ;# CHARS TO POINTER IN ALTER MODE
DATA (ALTFLG) ;ON IF CR INSERTED IN ALTER MODE
DATA (ALTINC) ;LINE INCREMENT FOR ALTER MODE
DATA (ARBBUF,MXWPL*2+1)
DATA (ARBCNT)
DATA (BGPG) ;LARGEST PAGE NUMBER OF FILE
DATA (BLIN)
DATA (BOTLIN) ;LINE # PRECEDING LOWEST LINE TRANSFERRED
DATA (BPW)
DATA (BUFHD) ;→AFTER TTY BUFFERS, BEFORE DISK BUFFERS
DATA (BUFP) ;→WORKING BUFFER
DATA (BUFSAV)
DATA (CASEBT) ;FOR CASE TRANSLATIONS (←LOWER, ETC.)
DATA (CCNT)
DATA (CLN) ;"." LINE
DATA (CODEBF,4*SRNUM+2)
DATA (COPDL) ;SAVE PDL FOR ERRORS, WHEN IN FILE→FILE COPY
DATA (CORTOP) ;JOBREL AFTER WORKING BUFFER ALLOC
DATA (CPG) ;CURRENT PAGE CONTAINING (PNTR)
DATA (CPGL) ;"." PAGE
DATA (CURINS) ;LINE # TO INSERT IF NO "I" ARGUMENT
IFEDUPL,{
DATA (DDTINB,=25) ;DDT-INPUT BUFFER
}
DATA (DESTN)
DATA (DESTLN) ;DESTINATION IN COPY AND
DATA (DESTPG) ; TRANSFER COMMANDS
DATA (DPG) ;DESIRED PAGE FOR FIND
DATA (EDNAM) ;NAME OF FUNNY TEMP FOR RECOPY
DATA (ELIN)
DATA (ENDD) ;POINTER TO END OF SPECIAL COPY BUFFER
DATA (FILPT) ;END OF WORKING BUFFER (FOR FILLING)
DATA (FINCR) ;INCR1 FOR COPY
DATA (HIGH1)
DATA (HILN) ;LAST (OR ONLY) LINE OF CURRENT RANGE
DATA (HIPG) ; " FOR PAGE
DATA (HLFWC) ;HALF WRK BUF SIZE --USED TO DETERMINE ACTION IN DUMP
DATA (IBUF,3) ;INPUT BUFFER HEADER
DATA (INCR) ;INSERT/REPLACE INCREMENT
DATA (INCST)
DATA (INDNT)
DATA (INPG) ;PAGE BEING INPUT (FOR ORDER CHECKING)
DATA (IPG) ;CURRENT PAGE TO INSERT ON, IF NONE GIVEN
DATA (JFLOP,,=1) ;L/R JUSTIFICATION FLIP-FLOP
DATA (LIBUF,MXWPL+2) ;LINE INPUT AND ALTERATION BUFFER
DATA (,1,<BYTE (7)15,15,15,15,15>);MAKE SURE IT TERMINATES RIGHT
DATA (LIBUF2,MXWPL+2) ;FOR CR INSERT IN ALTER MODE
DATA (LINK)
DATA (LINL)
DATA (LINOUT)
DATA (,1,<ASCIZ ./.>)
DATA (LLHILN)
DATA (LLHIPG)
DATA (LLRCNT)
DATA (LLRPG)
DATA (LMAR,,1) ;LEFT MARGIN COLUMN SETTING
DATA (LOBUF,3)
DATA (LOGPG)
DATA (LOLN) ;FIRST LINE OF CURRENT RANGE
DATA (LOPG) ;FIRST PAGE OF SAME
DATA (LPTBUF,203*2+1)
DATA (LSBUFN)
DATA (LSBUF,<(SRBLG/5*2)*LSNUM>)
DATA (LSPNT,SRNUM*LSNUM)
DATA (LSTCNT)
DATA (LSTLN)
DATA (LSTPG) ;LAST PAGE # INSERTED IN COPY BUFFER
DATA (LWRD)
DATA (MAXLN,1,<ASCID /99999/>);MAX ALLOWABLE LINE #
DATA (MAXWC) ;MAX ALLOWABLE WC FOR WORKING BUFFER
DATA (MAXWL)
DATA (NAMI,4) ;INPUT LOOKUP BLOCK
DATA (NAMO,4) ;OUTPUT LOOKUP BLOCK
DATA (NCNT) ;CHAR CNT FOR NEW LINE (REPLAC OR INSERT)
DATA (NLIN1) ;#LINES ON FIRST PAGE (COPY)
DATA (NLIN2) ;" LAST "
DATA NORENT ;DON'T DO EMERGENCY FLUSH IF ON
DATA (OBUF,3) ;OUTPUT BUFFER HEADER
DATA (OCNT) ;CHAR CNT FOR OLD LINE (BEING REPLACED)
DATA (OCNT1)
DATA (OLDLIN) ;USED IN FILLBF FOR ORDER CHECKING
DATA (OPTR)
DATA (ORGEXT) ;ORIGINAL FILE
DATA (ORGNAM) ; NAME
DATA (ORGPPN) ; INFO
DATA (ORGPRO) ; "
DATA (PDL,PDLSIZ) ;PUSH DOWN LIST
DATA (PGDELS) ;#PAGES DELETED IN COPY/TRANSFER
DATA (PGHS,7,<ASCII / /
ASCII / /
BYTE (7) 40,40,40,40,15
ASCIZ /PAGE /
>)
DATA (PGHD,12) ;ALL FOR LPT OUTPUT
DATA (PGINSD)
DATA (PMAR,,1)
DATA (ASCZ1,,<ASCII /INC1=/>)
DATA (PRNTO1,2,<0
ASCIZ /
/>)
DATA (ASCIZ2,,<ASCII /INC2=/>)
DATA (PRNTO2,2,<0
ASCIZ /
/>)
DATA (REENTSW) ;FOR EMERGENCY EXITS
DATA (RENCNT) ;FOR PANIC MEASURES AT ENDIT TIME
DATA (REINC)
DATA (REM)
DATA (RMAR,,=69) ;RIGHT MARGIN COLUMN
↓MAXL←RMAR
DATA (RPCNT)
DATA (RPGSW) ;IF ON, READING COMMANDS FROM QQSVED.RPG
DATA (RPHILN)
DATA (RPHIPG)
DATA (RPPG)
DATA (RSTRCT)
DATA (RSW) ;/R TYPED IN COMMAND LINE
DATA (R1BUF,SRBLG/5+2)
DATA (R1PNT,SRNUM) ;"FOR" STRING POINTER
DATA (R2BUF,SRBLG/5+2)
DATA (R2PNT,SRNUM) ;"SUBSTITUTE" STRING POINTER
DATA (SAVC) ;SAVCHR FOR JUST/JOIN KLUDGE
DATA (SAVCHR) ;SAVCHR FOR SCANNER
DATA (SAVCNT) ;NO OF LINE-CHANGING OPERATIONS SINCE LAST "W"
DATA (SAVNUM) ;NO OF " BETWEEN "W"'S
DATA (ISVNUM) ;SAVNUM FOR INSERT MODE
DATA (ISVCNT) ;SAVCNT FOR INSERT MODE
DATA (INSSW) ;FOR INSERT MODE "W" FEATURE
DATA (SINCR) ;INCR2 FOR COPY
DATA (SQBUF,2,<0
ASCIZ / />) ;TAB-- FOR PRINTING LINE NUMBERS
DATA (SRBUF,SRBLG/5+2)
DATA (SRCALP)
DATA (SRCNT)
DATA (SRHILN)
DATA (SRHIPG)
DATA (SRPG)
DATA (SRPNT,SRNUM) ;SEARCH STRING POINTER
DATA (SSW) ;/S TYPED IN COMMAND LINE
DATA (STARTD) ;START OF DELETED CODE FOR TRANSFER
DATA (SVALTP) ;TMP FOR SAVING ALTP IN ALTER COMMAND
DATA (SVCCNT)
DATA (SVCNT) ;HOLDS ! ARG FOR COMMANDS
DATA (SVCRLC) ;TEMP BP HOLDER WHEN INSERTIN CR IN Z MODE
DATA (SVERN)
DATA (SVINC) ;INCR FROM LINE # (I.E., 500+1)
DATA (SVJRL) ;SAVE CORE ADDRESSES FOR
DATA (SVJRL2) ; RELEASE AFTER COPY COMMANDS
DATA (SVLNUM)
DATA (SVPT)
DATA (SVT1E) ;STORE T1 IN ERROR HANDLER
DATA (SVWD) ;WORD READ BUT NOT STORED BY FILLBF
DATA (SVWD2) ;FOR ORDER CHECKING IN FILLBF
DATA (SVWD3) ;TEMP IN DELETE
DATA (TCHR)
COMMENT /STUFF FOR SPOOLING LISTINGS/
DATA (SPOOLR)
DATA (OPENBK,4)
DATA (TIBUF,3) ;TTY INPUT BUFFER HEADER
DATA (TMPT1) ;RDTECO TEMP
DATA (TOBUF,3) ;TTY OUTPUT BUFFER HEADER
DATA (TPNT)
DATA (TRANST) ;PAGE ON WHICH DELETION STARTS (TRANSFER)
DATA (WC) ;CURRENT WORKING BUFFER WORD COUNT
DATA (WCNT)
DATA (WRDL)
DATA (WTBL,,<[1]>)
DATA (ZCOMMND) ;ON IF INSERTING CR IN Z MODE, OFF IF IN A
DATA (ZSW) ;USED TO CONTROL ALTER-XTEND COMMANDS
;(USE SYSTEM OR INTERNAL, ALTER OR XPAND)
SUBTTL TWO SEGMENT SOS INITIALIZATION CODE
LOC 124 ;SET UP RE-ENTER ADDRESS
REENT ;TO STOP SEARCHES AND SUBSTITUTES EARLY.
RELOC
Comment ⊗ DCS
Here is code to create a second segment (one time only), and
to attach to it (each time program is restarted). It just pokes
at the system in any number of different ways. ⊗
IFN TWOSGM,{
ERRHD: 0
JRST ERRHDA ;PUT UUO TRAP LOCATION IN LOWER SEGMENT
STPTA: TDZA T1,T1 ;NO RPG
MOVEI T1,1 ;RPGSW TO BE SET
ADDI T1,STPT ;THIS IS STARTING ADDRESS
HRRM T1,JOBSA ; BEFORE YOU FORGET IT
MOVEI 17,FRSTACS ;SAVE ORIGINAL VALUES
BLT 17,FRSTACS+16 ; BECAUSE THERE ARE FILE NAMES
; AND THINGS IN THERE
CHK2: CALLI 400023 ;LINKUP IF 2D SEGMENT THERE ALREADY
SKIPA ; NOT THERE, USE THIS COPY
JRST MOVSY ; THERE, MOVE SYMBOL TABLE DOWN AND COLLAPSE
MAK2: HRRZ T1,JOBSYM ;BY DEFINITION, END OF 2D SEGMENT CODE
SUBI T1,SEG2LOC ;T1 IS LENGTH OF 2D SEGMENT CODE
MOVE T2,T1 ;CORE2 PROBABLY CLOBBERS
CALLI T2,400015 ;CALL CORE2 TO MAKE A 2D SEGMENT
HALT ; SHOULD BE ABLE TO GET IT
HRRI T2,400000 ;DEST
HRLI T2,SEG2LOC ;SOURCE
BLT T2,400000-1(T1) ;MOVE 2D SEGMENT CODE UP
CALLI T1,36 ;WRITE-PROTECT 2D SEGMENT
HALT ;COULDN'T DO IT?
MOVSY: MOVEI T2,SEG2LOC
SKIPN JOBDDT
JRST MOVSY1
HLRE T3,JOBSYM ;-SYMBOL TABLE SIZE IN T3
HRL T1,JOBSYM ;BLT WORD FOR SYMBOLS IN T1
HRRI T1,SEG2LOC
HRRM T1,JOBSYM ;UPDATE JOBSYM
MOVNI T2,-SEG2LOC(T3) ;NEW END OF SYMBOLS ADDR IN T2
BLT T1,-1(T2) ;MOVE SYMBOLS DOWN
MOVSY1: HRRZ T1,T2 ;CORE CLOBBERS AC
CALLI T1,11 ; CUT DOWN TO REASONABLE 1ST SEGMENT SIZE
HALT ; BUT IT'S EASY!!
HRLM T2,JOBSA ; IT UP
CALLI ;TRANSFER TO JOBFF, CLEAR THE WORLD
GOEDIT: MOVSI 17,FRSTACS ;RESTORE ALL THE ORIGINAL
BLT 17,16 ; GOODIES
HRRZ T1,JOBSA ;STARTING ADDRESS
JRST (T1)
FRSTACS: BLOCK 17 ;SAVE ORIGINAL ACS HERE FOR A WHILE
SEG2LOC:
PHASE 400000 ;PUT ALL ELSE IN UPPER SEGMENT
}
SUBTTL REENTER-ER, RPG SWAPPER -- BEGINNING OF SEGMENT 2
REENT: SETOM REENTSW ;JUST FLAG AND CONTINUE
JRST @JOBOPC
CREFIT: IFE FULDPX,<MOVEI T1,[ASCIZ /
/]
CALLI T1,3>
IFN FULDPX,<TTYUUO 3,[ASCIZ /
/]>
MOVEI T1,RPGR
CALL T1,[SIXBIT /SWAP/]
CALLI 12
RPGR: SIXBIT /SYS/
SIXBIT /RPG/
0↔1↔0
SUBTTL INITIALIZATION
;HERE IS THE INITIALIZE CODE
STPT: SKIPA
JRST [SETOM RPGSW ;IN RPG MODE
SOS JOBSA ;REST START
MOVEM 14,ORGNAM ;SAVE NAME
MOVEM 14,NAMI
HLLZM 13,ORGEXT
HLLZM 13,NAMI+1
MOVEM 11,ORGPPN
MOVEM 11,NAMI+3
IFE STANSW,<MOVSI FL,QMODF>
IFN STANSW,<MOVEI FL,0>
MOVEI FL2,0
MOVEM 15,HILN ;LINE NUMBER
MOVEM 15,LOLN ;SET UP TO PRINT (FOR SAIL ETC)
MOVEM 16,HIPG ;AND PAGE NUMBER
MOVEM 16,LOPG
MOVEI C,0
TRNE 13,400000 ;CREATE MODE?
MOVEI C,200
TRNE 13,200000
TRO FL,READOF ;SET FOR READ ONLY
JRST RPGRET]
SETZM RPGSW
CALLI
IFN STANSW,< MOVEI FL,0 ;CLEAR FLAG REGISTER>
IFE STANSW,< MOVSI FL,QMODF ;SET FOR ? IS NOT SPECIAL>
MOVEI FL2,0 ;CLEAR SECOND FLAG REGISTER
RPGRET: MOVE T1,[JSR ERRHD] ;SET UP UUO HANDLER
SETOB 0,SCRUP2 ;THIS BETTER NOT CHANGE.
MOVEM T1,41
CALLI T1,14
IDIVI T1,=372
MOVEI T1,=25
MOVEM T1,SCRUP1
CAIE T2,=93
SETZM SCRUP2
MOVEI T1,PDLOV ;SET UP A PDLOV TRAP
MOVEM T1,JOBAPR
MOVEI T1,200000 ;SET FOR PDLOV ONLY
CALLI T1,16 ;APRENB
IFN FULDPX,<IFN STANSW,<INIT TTY,401 ;NO DUPLEX BUCKY BITS>
IFE STANSW,<INIT TTY,1 ;SET UP TTY FOR NO ALTMODE DUPLEXING>>
IFE FULDPX,< INIT TTY,401>
SIXBIT /TTY/
XWD TOBUF,TIBUF
CALLI 12 ;LOSE BIG
INIT IN,14
SIXBIT /DSK/ ;DISK FOR INPUT AND OUTPUT
XWD 0,IBUF
JRST NODSK
INIT OUT,14
SIXBIT /DSK/
XWD OBUF,0
JRST NODSK ;WE ARE IN TROUBLE
INBUF TTY,2
OUTBUF TTY,2 ;SET UP TELETRIPE BUFFERS
MOVE T1,JOBFF ;NOW SAVE JOBFF
MOVEM T1,BUFHD ;FOR LATER RECOPY OPERATIONS
INBUF IN,2 ;GET DISK BUFFERS SET UP
OUTBUF OUT,2
MOVE T1,JOBFF
SETZM (T1) ;SAVE A ZERO WORD
ADDI T1,1 ;NEXT ONE STARTS
MOVEM T1,BUFP ;START OF THE BUFFER
SKIPN T1,SAVNUM ;# LINE-CHANGING OPERATIONS BETWEEN "W"'S
HRLOI T1,377777 ;INITIALIZE TO BIG NUMBER
MOVEM T1,SAVNUM
MOVEM T1,SAVCNT ;ALSO INITIALIZE COUNTER
SKIPN T1,ISVNUM ;SIMILARLY FOR INSERT MODE COUNTS
HRLOI T1,377777
MOVEM T1,ISVNUM
MOVEM T1,ISVCNT
MOVE P,[IOWD PDLSIZ,PDL]
TRNN FL2,SVIT ;SKIP * IF DOING W COMMAND
SKIPE RPGSW
JRST RPGR1
MSSG (T1,<
FILE=>) ;PRINT THE FILE=
SUBTTL FILE NAME SCANNER
PUSHJ P,SCAN
PUSHJ P,READNM ;GET A FILE NAME
JRST ILFN ;ILLEGAL FORMAT
SKIPE SSW ;CHECK FOR AN S SWITCH
JRST ILFN
MOVE T1,NAMI
MOVEM T1,ORGNAM
MOVE T1,NAMI+1
MOVEM T1,ORGEXT
MOVE T1,NAMI+3
MOVEM T1,ORGPPN
SKIPE RSW ;ON IF /R
TRO FL,READOF
CKTRM2: TRNN FL,TERMF ;IS IT A TERMINATOR?
CAIN C,200 ;OR ALTMODE
JRST .+2 ;YES, WE'RE OK
JRST ILFN
RPGR1: SETZM NAMO
MOVE T1,[XWD NAMO,NAMO+1]
BLT T1,NAMO+3
IFE STANSW, <
CALLI T1,14 ;GET CURRENT DATE
CALLI T2,22 ;AND TIME IN TICKS
LSH T1,=21 ;USE TO MAKE A STRANGE NAME
IOR T1,T2
>;NOSTANSW
IFN STANSW, <;MAKE UP NAME BASED ON JOB NUMBER
CALLI T1,30 ;PJOB
IDIVI T1,=10 ;TEN'S PLACE IN T1, ONE'S PLACE IN T2
LSH T1,6
IOR T1,T2
IOR T1,['$ED$00'] ;JOB NUMBER IS PART OF EDIT NAME
>;STANSW
MOVEM T1,EDNAM ;SAVE FOR LATER
MOVEM T1,NAMO
MOVSI T1,'TMP'
MOVEM T1,NAMO+1
MOCO: MOVE T1,JOBREL ;FIND THE END OF CORE
MOVEM T1,CORTOP
SUBI T1,2*MXWPL+2 ;LEAVE SPACE FOR A COUPLE OF LINES
MOVEM T1,FILPT ;THIS IS HOW FAR TO FILL THE BUFFER
MOVE T1,CORTOP ;NOW FIND THE SIZE
SUB T1,BUFP
CAIGE T1,3000
JRST [MOVE T2,JOBREL
ADDI T2,2000
CALLI T2,11
SKIPA
JRST MOCO
JRST .+1] ;DID NOT GET IT, GIVE UP
MOVE T2,T1 ;GET A COPY
SUBI T2,MXWPL+1 ;WHEN TO START DUMPING
MOVEM T2,MAXWC
ASH T1,-1 ;TAKE HALF OF IT
MOVEM T1,HLFWC ;SAVE THAT FIGURE
TRNE FL2,SVIT
JRST NOSV1 ;SKIP SOME MORE STUFF IF IN W COMMAND
IFN STANSW,<
IFE FULDPX,<
CALL T1,[SIXBIT /GETLIN/] ;GET LINE NUMBERS FOR THIS TTY
LDB T2,[POINT 6,T1,23] ;THE DPYS ARE 20-25
CAIE T2,'2' ;SO THIS SHOULD BE A 2
JRST NODPY
LDB T2,[POINT 6,T1,29]
JUMPE T2,NODPY ;NO IT WAS TTY2
CAIG T2,'5' ;OR HIGHER THAN 25>
IFN FULDPX,<MOVNI T1,1 ;SET NEG TO GET OWN LINE
TTYUUO 6,T1 ;GET LINE CHARACTERISTICS
TLNE T1,420000 ;THE HIGH ORDER BIT SAYS ITS A DPY>
TRO FL,DPYF ;IT IS A DPY, SET IT UP>
TLNE T1,12000 ;IS IT AN M37, OR AN IMLAC.
TRO FL,M37F ;SET FLAG.
NODPY: MOVE T1,[ASCID /00000/]
MOVEM T1,CLN ;SET UP THE CURRENT LINE
MOVE T1,[ASCID /00100/] ;AND CURRENT INCREMENT
MOVEM T1,INCR
MOVEM T1,CURINS ;CURRENT PLACE TO INSERT IF NO ARGS TO I
NOSV1: MOVEI T1,1 ;AND THE CURRENT PAGE
MOVEM T1,CPG
TRNE FL2,SVIT ;DO NOT CHANGE LOGICAL PAGE (.)
JRST .+3
MOVEM T1,CPGL
MOVEM T1,IPG ;CURRENT PAGE TO INSERT ON
MOVE PNTR,BUFP ;SET THE BUFFER POINTER
MOVEI T1,1 ;SET INPUT PAGE
MOVEM T1,INPG
SETZM SVWD ;O WORDS WAITING
SETZM WC ;ZERO WORD COUNT FOR START
SETZM OLDLIN ;UESD FOR ORDER CHECKING ON INPUT
TRNE FL2,SVIT
JRST NOSV2
SETZM CASEBT ;0 FOR LETTERS AS UPPER CASE 40 FOR LOWER
SETZM SRPNT ;NO SEARCH STRING YET
SETZM R1PNT ;ALSO REPLACE STRINGS
SETZM R2PNT
CAIN C,200 ;IS IT ALTMODE
JRST CREAT
MOVSI T1,1 ;SET BIG PAGE LARGE FOR NOW
MOVEM T1,BGPG
NOSV2: LOOKUP IN,NAMI
JRST NOFIL ;IT IS NOT THERE
HLLZ T1,NAMI+2 ;GET PROTECTION.
TLZ T1,777 ;AND ONLY THAT.
MOVEM T1,ORGPRO ;TO MEM.
TRNE FL,READOF
JRST NOENT ;DO NOT ENTER
LOOKUP OUT,NAMO ;SEE IF EDIT WAS FLUSHED SOMEHOW
JRST TMPENT ;NO, FILE IS VIRGIN
CLOSE OUT, ;DON'T ENTER EXTEND MODE
SKIPN NAMO+3 ;LOOK FOR THE FILE LENGTH
JRST TMPENT ;ZERO LENGTH FILE. FLUSH IT
MSGSTR (T1,<TEMPORARY EDIT FILE ALREADY EXISTS! DELETE?(Y OR N)>)
PUSHJ P,FILEX1 ;GET THE ANSWER
CALLI 12 ;LET HIM DO SOMETHING TO KEEP IT
TMPENT: SETZM NAMO+3 ;CLEAR AGAIN
ENTER OUT,NAMO
JRST EDFLIN ;SOME OTHER BASTARD IS USING IT
NOENT: TRO FL,BOF ;IS AT START OF FILE
TLO FL,FSTOPF ;FIRST OP
PUSHJ P,FILLBF ;AND FILL UP THE BUFFER
SKIPE RPGSW ;IF NOT RPG
SKIPN HILN ;OR NO LINE PASSED
JRST COMND ;GET A COMMAND AND DO IT
JRST RPGPRN ;ELSE FORCE A PRINT COMMAND
SUBTTL CREATE A FILE
;CREATE A NEW FILE
CREAT: SETZM ORGPRO ;DEFAULT PROTECTION IS GOOD FOR YOU.
LOOKUP IN,NAMI ;SEE IF THERE IS ONE OF THAT NAME
JRST CRTOK ;NO, ALL IS WELL
SETZM RPGSW ;SO CRLF AFTER Y WILL PRINT
PUSHJ P,FILEXST ;TELL HIM FILE EXISTS, GET DISPENSATION
JRST STPT ;HE SAID "NO", START ALL OVER
;HE SAID "YES", GO AHEAD
CRTOK: LOOKUP OUT,NAMO ;SEE IF TEMP FILE WAS NOT RENAMED
JRST TMPENC ; IT'S ALL RIGHT (SEE ABOVE)
SKIPN NAMO+3
JRST TMPENC ;NO HASSLE FOR EMPTY TEMP FILE
CLOSE OUT, ;DON'T ENTER EXTEND MODE
MSGSTR (T1,<TEMPORARY EDIT FILE ALREADY EXISTS! DELETE? (Y OR N)>)
PUSHJ P,FILEX1 ;FIND OUT WHAT HE WANTS TO DO
CALLI 12 ;RECONSIDER
TMPENC: SETZM NAMO+3 ;ZERO PPN YET AGAIN
ENTER OUT,NAMO ;GO DO THE OUTPUT
JRST EDFLIN ;FOOBAZ
SETZM (PNTR) ;ZERO FIRST WORD OF BUFFER
TRZ FL,READOF ;CREAT AND READOF ARE NOT POSSIBLE
TRO FL,BOF!EOF!EOF2 ;SAY AT START AND NO MORE TO READ
MOVEI T1,1 ;SET BGPG
MOVEM T1,BGPG
IFEDUPL {MOVEI T1,[0]} ;PRINT NOTHING IF RPGSW
SKIPE RPGSW ;SHOULD WE PRINT?
JRST CRTINS ;NO, GO INSERT LINE 100 (OR SO)
TERPRI (T1) ; YES, DO CRLF
JRST COMND ;AT LAST
SUBTTL READ A FILE NAME
READNM: SETZM NAMI
MOVE T1,[XWD NAMI,NAMI+1]
BLT T1,NAMI+3 ;CLEAR AREA
SETZM RSW ;AND SWITCH FLAGS
SETZM SSW
TRNN FL,IDF!NUMF ;IS IT AND IDENT
POPJ P, ;ERROR RETURN
MOVE T1,ACCUM
MOVEM T1,NAMI
PUSHJ P,SCAN
CAIN C,"[" ;CHECK FOR PPN
JRST SETPPN
CAIE C,"."
JRST CKTERM
PUSHJ P,SCAN ;THIS SHOULD BE AN EXTENSION
TRNN FL,IDF!NUMF
POPJ P,
MOVE T1,ACCUM ;GET IT
HLLZM T1,NAMI+1 ;AND PUT IT IN THE EXTENSION FIELD
PUSHJ P,SCAN
CAIE C,"[" ;NOW LOOK FOR PPN
JRST CKTERM
SETPPN: PUSHJ P,SCAN
TRNN FL,IDF!NUMF
POPJ P,
PUSHJ P,RJUST ;RIGHT JUSTIFY IT
IFE STANSW,< POPJ P, ;NON-SKIP RETURN IF NOT OCTAL>
HRLZM T1,NAMI+3
PUSHJ P,SCAN
CAIE C,","
POPJ P,
PUSHJ P,SCAN
TRNN FL,IDF!NUMF
POPJ P,
PUSHJ P,RJUST
IFE STANSW,< POPJ P, ;LOSE>
HRRM T1,NAMI+3
PUSHJ P,SCAN
CAIE C,"]"
POPJ P,
PUSHJ P,SCAN
CKTERM: CAIE C,"/" ;CHECK FOR READ ONLY MODE
JRST CPOPJ1 ;ALL OK
PUSHJ P,SCAN
TRNN FL,IDF
POPJ P,
MOVS T1,ACCUM
CAIN T1,'R '
SETOM RSW
CAIN T1,'S '
SETOM SSW
PUSHJ P,SCAN
SKIPN RSW
SKIPE SSW
AOS (P)
POPJ P,
SUBTTL PPN JUSTIFIER, FILE CONFLICT HANDLER
IFN STANSW,<
RJUST: MOVE T1,ACCUM
RJUST1: TRNE T1,77 ;IS THERE ANYTHING THERE?
POPJ P, ;YES, IT IS RIGHT JUSTIFIED IN LEFT HALF
LSH T1,-6 ;MOVE IT OVER
JRST RJUST1 ;WE KNOW THERE IS SOMETHING THERE>
IFE STANSW,<
RJUST: MOVE T3,ACCUM ;GET THE SIXBIT
MOVEI T1,0
RJUST1: MOVEI T2,0
LSHC T2,6
CAIL T2,'0' ;CHECK FOR OCTAL DIGIT
CAILE T2,'7'
POPJ P,
LSH T1,3
IORI T1,-'0'(T2)
JUMPN T3,RJUST1 ;DONE IF NULLS LEFT
AOS (P)
POPJ P, ;SKIP RETURN FOR ALL OK>
; TELL USER FILE EXISTS
; ASK HIM WHAT HE WANTS TO DO ABOUT IT
; GET HIS ANSWER
; ACT ACCORDINGLY
FILEXST:
MSGSTR (T1,<FILE ALREADY EXISTS! DELETE? (Y OR N)>)
FILEX1:
BACK: IFEDUPL {
MOVEI T1,DDTINB
CALLI T1,1 ;GET ANSWER
LDB T1,[POINT 7,DDTINB,6] ;TO T1
;} TTYUUO 0,T1 ;MUCH EASIER WITH FULDPX
ANDI T1,177 ;TURN OFF BUCKY BITS
CAIN T1,"Y" ;YES, DELETE IT
JRST CPOPJ1 ; (SKIP RETURN)
CAIN T1,"N" ;NO, DON'T DELETE IT
POPJ P, ; (NON-SKIP RETURN)
; THERE ARE NO OTHER POSSIBILITIES
MSGSTR (T1,TYPE Y OR N)
JRST BACK
PGMK: ASCID / /
SUBTTL COMMAND DISPATCHER
;HERE IS THE COMMAND DECODER AND DISPATCHER
COMND: SETZM SAVCHR ;SCAN SHOULD GET RESET AT THIS POINT
SETZM REENTSW ;WAS USED TO STOP A SUBSTITUTE OR SEARCH
IFN FULDPX,<IFN STANSW,<SETSTS TTY,401>
IFE STANSW,<SETSTS TTY,1 ;JUST IN CASE DUPLEXING IS OFF>>
TLNE FL,SRCOP ;THIS CASE IS SPECIAL SINCE WE
SKIPA P,COPDL ;SHOULD NOT DESTROY SAVED ITEMS
MOVE P,[IOWD PDLSIZ,PDL] ;ALSO PDL (IN CASE OF ERRORS)
TLNE FL,SRCOP ;DOING SECOND FILE SEARCH?
JRST NOCPCK ;DO NOT GET OUT OF COPY MODE
TLZE FL,ISCOP ;IN COPY MODE?
JRST COPDON ;YES, DO SPECIAL CLEAR OUT
NOCPCK: MOVEI T1,[0] ;DON'T PRINT IF SUPN
TRNN FL2,SUPN ;SUPPRESS * AFTER PRETTY PRINT
MSSG (T1,*) ;PRINT A STAR
SETZM TIBUF+2
TRZ FL2,SVIT!SUPN ;MAKE SURE THAT THIS GETS TURNED OFF
MOVEI T1,LSNUM ;RESET LINE SEARCH STRINGS
MOVEM T1,LSBUFN
ICHK: MOVN T1,INSSW ;CHECK INSERT MODE SAVE REQUEST
JUMPE T1,CHKW ;NO SUCH REQUEST
MOVEM T1,INSSW ;UPDATE
JUMPG T1,DOW ;WANT TO SAVE
SETZM INSSW ;RESUME INSERT MODE
MOVEI T1,[BYTE (7) "I",15,12]
JRST DOI
CHKW: TRNN FL,READOF ;DON'T SAVE IF READ ONLY MODE
SKIPLE SAVCNT
JRST CMND1 ;OR IF NOT TIME YET
DOW: MOVE T1,SAVNUM
MOVEM T1,SAVCNT
MOVE T1,ISVNUM ;RESET THESE
MOVEM T1,ISVCNT
MSG (T1,<SAVING>)
MOVEI T1,[BYTE (7) "W",15,12]
DOI: HRLI T1,440700 ;A GOOOD BYTE POINTER
MOVEM T1,TIBUF+1 ;FOOL GNCH
MOVEI T1,4 ;WILL GET THREE CHARS
MOVEM T1,TIBUF+2
CMND1: PUSHJ P,GNCH ;READ A CHARACTER
CAIE C,15
JUMPE CS,CMND1 ;IGNORE SPACES ETC
TLNE CS,LETF⊗16 ;CHECK TO SEE IF LETTER
TRZ C,40 ;AND CONVERT TO UPPER CASE
MOVSI T1,-CMDLG ;GET LENGTH OF COMMAND TABLE
CAME C,CMD1(T1) ;COMPARE
AOBJN T1,.-1 ;CHECK FOR MATCH
SKIPGE CMD2(T1) ;DOES THIS COMMAND PERHAPS CHANGE THINGS?
SOS SAVCNT ;YES, COUNT SUCH COMMANDS
JUMPL T1,@CMD2(T1) ;DISPATCH IF FOUND
NERROR ILC ;ELSE ERROR
CMD1: "W"↔"G"↔"E"↔"I"↔"D"↔"R"↔"J"
"A"↔"Z"↔"X"↔"Q"↔"N"↔12↔200↔"F"↔"S"↔"M"↔"C"
"T"↔"P"↔"L"↔"←"↔"="↔15
CMDLG←←.-CMD1
DEFINE CG(A) <XWD 400000,A> ;THIS COMMAND CHANGES THINGS
CMD2: SVCOD↔GEND↔ENDIT↔CG(INSERT)↔CG(DELETE)↔CG(REPLAC)↔CG(JUST)
CG(ALTER)↔CG(ZALT)↔CG(XPAND)↔CG(QPAND)↔CG(NUMBER)↔NXTLIN
BAKLIN↔SEARCH↔CG(SUBST)↔CG(MARK)↔CG(COPY)
CG(TRANS)↔PRINT↔0+LIST↔0+SET↔GIVE↔COMND
SUBTTL END OF EDIT CODE (THIS IS THE DANGEROUS PART!)
BEGIN ENDIT
;CODE TO FINISH OFF EDIT
↑SVCOD: TRO FL2,SVIT ;SET TO DO A SAVE
JRST END0
↑GEND: TLOA FL,GCOM ;GO
↑ENDIT: TLZ FL,GCOM ;NORMAL TYPE END
END0: TLNE FL,SRCOP
JRST DSCOP ;FINISH UP THE COPY COMMAND
TRNE FL,READOF ;IF READ ONLY
JRST ENDEN2
TRZ FL,NEWFL ;SET TO WANTS SAME OLD PROGRAM
MOVE T1,ORGNAM ;GET THE ORIGINAL NAME
MOVEM T1,NAMI ;GET SET UP
MOVE T1,ORGEXT ;AND EXTENSION
HLLZM T1,NAMI+1
PUSHJ P,NSCAN ;GET A NAME
NERROR ILC ;SKIPS IF NO ERRORS
PUSHJ P,OCOMPL ;FINISH COPY
CLOSE IN,0 ;AND CLOSE FILES
CLOSE OUT,0
END7: SETZM NAMI+3 ;ZERO PPN
LOOKUP IN,NAMI ;GET IT
JRST END3 ;NO WORRY
TRNN FL,NEWFL ;IS THIS A NEW FILE?
JRST END4 ;NO, WE SHOULD HAVE FOUND IT
PUSHJ P,FILEXST ;TELL USER IT EXISTS, GET DISPENSATION
JRST END8 ; DON'T DELETE IT
; DELETE OLD COPY
END4: SETZM NAMI ;DELETE THE LOSER
SETZM NAMI+3
END3:
END5: SETOM RENCNT
END66: MOVE T1,EDNAM ;GET THE OUTPUT
MOVEM T1,NAMO
MOVSI T1,(<SIXBIT /TMP/>)
MOVEM T1,NAMO+1
SETZM NAMO+3
LOOKUP OUT,NAMO
JRST EDFLIN ;GIVE UP
MOVE T1,ORGNAM ;SET TO DESIRED NAME
MOVEM T1,NAMO
MOVE T1,ORGEXT
MOVEM T1,NAMO+1
MOVE T1,ORGPRO ;PROTECTION.
MOVEM T1,NAMO+2
SETZM NAMO+3
SKIPE NAMI ;DO WE WANT TO DELETE OLD FIRST?
JRST NORENI ; NO, NEW NAME
RENAME IN,NAMI ;DELETE OLD FILE AT LAST MINUTE POSSIBLE
JRST FIU ;SOMETHING BAD HAPPENED
NORENI: RENAME OUT,NAMO
AOSA T1,RENCNT ;FAILED, SEE HOW BAD IT IS
JRST ENDEND ;OK, GO FINISH UP
JUMPG T1,ENDEN1 ;BAD, PANIC.SOS EXISTS ALREADY, KEEP TEMP
TRZ FL,NEWFL
SETOM NAMI ;DON'T DO RENAME AGAIN
CLOSE IN,
CLOSE OUT, ;CLEAR THE WORLD
MOVE T1,['PANIC '] ;DEFAULT FILE WHEN THINGS GO WRONG
MOVEM T1,ORGNAM ;CAN'T USE ORIG NAME AGAIN IN ANY CASE
MOVSI T1,'SOS'
MOVEM T1,ORGEXT
SETZM ORGPRO ;DONT PROTECT HIM.
JRST END66 ;TRY ONCE MORE TO GET A TYPABLE NAME
; FILE BAD, AND PANIC.SOS STILL EXISTS
ENDEN1: MSSG (T1,<SOMEONE IS READING YOUR FILE.
PANIC.SOS ALREADY EXISTS.
SO YOU CAN FIND YOUR EDITED TEXT ON FILE >)
MOVE T2,EDNAM ;PRINT OUT NAME OF EDIT TEMP FILE
PRTSIX: MOVEI T1,0
LSHC T1,6 ;SIXBIT TO T1
ADDI T1,40 ;ASCII TO T1
TTYUUO 1,T1 ;TYPE IT IF FULDPX, ELSE LOSE
JUMPN T2,PRTSIX
MSSG (T1,<.TMP -- SORRY.
>)
JRST ENDEN2 ;WE'VE DONE THE BEST WE CAN
ENDEND: SKIPL RENCNT ;DID ALL GO WELL?
MSG (T1,<SOMEONE IS READING YOUR FILE.
SO YOU CAN FIND YOUR EDITED TEXT ON FILE PANIC.SOS -- SORRY.>)
ENDEN2:
CLOSE OUT,0
RELEASE OUT,0
CLOSE IN,0
RELEASE IN,0
TRNE FL2,SVIT
JRST [CALLI
SETZM RPGSW ;RESET ALL THE GOOD JUNK
TLZ FL,TECOF
TRZ FL,BOF!EOF!EOF2
TRNN FL,READOF
SETZM ORGPPN
MOVE T1,ORGNAM
MOVEM T1,NAMI
MOVE T1,ORGEXT
MOVEM T1,ORGPPN
JRST RPGRET] ;AND GO
TLNN FL,GCOM
CALLI 12
JRST CREFIT
NSCAN: PUSHJ P,SCAN ;SEE IF HE WANTS TO GIVE IT A NEW NAME
TRNE FL,TERMF ;TERMINATOR?
JRST CPOPJ1 ;DO SKIP RETURN
PUSHJ P,READNM ;GET A FILE NAME
POPJ P,
SKIPN RSW
SKIPE SSW ;SWITCHES ILLEGAL
POPJ P,
SKIPN NAMI+3 ;ALSO PPN
TRNN FL,TERMF
POPJ P,
TRO FL,NEWFL
MOVE T1,NAMI ;SET AS NAME
MOVEM T1,ORGNAM
MOVE T1,NAMI+1
MOVEM T1,ORGEXT
JRST CPOPJ1
END8: MSSG (T1,<
*>)
END6: SETZM SAVCHR ;GET A NEW NAME. RESET SCAN
SETZM TIBUF+2
PUSHJ P,NSCAN
SKIPA
JRST END7
MSGSTR (T1,<?????>)
JRST END6 ;YOU'RE GOING TO DO IT OVER AND OVER UNTIL
;YOU GET IT RIGHT
FIU: MSGSTR (T1,<FILE IN USE OR WRITE PROTECTED. TRY ANOTHER NAME>)
JRST END6
INFCNF: MSG (T1,<THERE IS INFINITE CONFUSION. YOU LOSE.>)
CALLI 12
BEND ENDIT
SUBTTL INSERT ROUTINE
BEGIN INSERT
;INSERT A LINE
↑CRTINS:MOVEI T1,1 ;SET UP TO START INSERTING AT LINE 100 PAGE 1
MOVEM T1,HIPG
MOVE T1,[ASCID /00100/]
MOVEM T1,HILN
JRST INSGO ;AND AWAY WE GO
↑INSERT:PUSHJ P,SCAN
TRNE FL,TERMF ;CHECK FOR NO ARGUMENTS
JRST [MOVE T1,IPG
MOVEM T1,HIPG
MOVE T1,CURINS
MOVEM T1,HILN
JRST INSGO] ;GO BACK TO INSERTING WHERE YOU WERE
PUSHJ P,GET1 ;GET ONE LINE/PAGE NUMBER
TRNN FL,READOF ;ERROR IF READ ONLY MODE
TRNN FL,LINSN ;WAS A LINE NUMBER SEEN
NERROR ILC ;ERROR IF NOT
CAIE C,"," ;IF A COMMA, SET INCREMENT
JRST NOINC ;NO, KEEP OLD ONE
PUSHJ P,SCAN ;GET THE NUMBER
TRNE FL,NUMF ;WAS IT A NUMBER?
CAMN T1,[ASCID /00000/] ;DO NOT PERMIT 0 INCR
NERROR ILC ;HE WAS CONFUSED
MOVEM T1,INCR ;SET INCREMENT
PUSHJ P,SCAN ;SCAN PAST IT
NOINC: TRNN FL,TERMF ;TERMINATOR?
NERROR ILC ;LOSE
INSGO: MOVE T1,HIPG ;GET THE PAGE TO GO TO
MOVEM T1,DPG ;AND SET IT UP
MOVE SINDEX,HILN ;ALSO LINE
PUSHJ P,FIND ;GO GET UM
MOVE T2,CPG ;DEMAND CORRECT PAGE MATCH
CAME T2,HIPG
NERROR NSP
CAMN T1,HILN ;ARE THEY MATCHING?
JRST FIXINL ;GO MAKE UP A LINE NUMBER
INSLP: SETZM OCNT
SOSG ISVCNT ;TIME TO SAVE THE WORLD?
JRST SVINS ;YES, SAVE AND RE-INSERT
MOVE T1,HILN ;TELL HIM THE LINE HE IS INSERTING
MOVEM T1,LIBUF ;AND PUT IT IN THE BUFFER
PUSHJ P,OUTSN ;PUT IT OUT
PUSHJ P,RDLIN ;READ A LINE
JRST LVINS ;YES, GET OUT OF INSERT MODE
MOVEM T1,NCNT ;HERE IS THE COUNT OF THE NEW ONE
PUSHJ P,INSED ;GO INSERT
PUSHJ P,FINDN ;MOVE UP A LINE
PUSHJ P,FILLB ;AND DUMP SOME IF NECESSARY
MOVE T1,CPG ;SET CURRENT LINE AND PAGE TO LAST
MOVEM T1,CPGL ;ONE REALLY INSERTED
MOVE T1,HILN
MOVEM T1,CLN
MOVE T2,INCR ;GET NEXT LINE TO INSERT
PUSHJ P,ASCIAD
CAMG T1,INCR ;HAVE WE WRAPED AROUND
JRST COMND ;YES, STOP
MOVEM T1,HILN ;STORE FOR REFERENCE
↑ENTINS:SKIPN T1,(PNTR) ;GET THE LINE POINTED TO
JRST INSLP ;ALWAYS INSERT AT END OF FILE
CAME T1,PGMK ;OR AT END OF PAGE
CAMLE T1,HILN ;HAVE WE FOUND A MATCH OR PASSED OVER A LINE?
JRST INSLP ;NO, INSERT
JRST COMND ;RETURN TO COMMAND
SVINS: SETOM INSSW ;MARK FOR "W","I" PAIR
LVINS: MOVE T1,HILN
MOVEM T1,CURINS ;SET PLACE TO INSERT NEXT TIME
MOVE T1,CPG
MOVEM T1,IPG
↑LEVINS:
TERPRI (T1) ;GIVE HIM SOMETHING SO * NOT ON SAME LINE
JRST COMND
FIXINL: MOVE T2,INCR ;SET TO ADD INCR
PUSHJ P,ASCIAD ;ADD
PUSH P,T1 ;SAVE RESULT
PUSHJ P,FINDN ;GET THE NEXT ONE
POP P,T2
CAMG T2,HILN ;IS THERE A WAR PROBLEM
JRST INCBAD ;YES, WE MUST TRY TO COMPUTE ONE
JUMPE T1,INCOK ;END OF FILE, ANY INC IS OK
CAME T1,PGMK ;ALSO OK IF A PAGE MARK
CAMGE T2,T1 ;OR IN CORRECT ORDER
JRST INCOK
INCBAD: CAME T1,PGMK
SKIPN T1
MOVE T1,[ASCID /9999:/] ;ONE OVER THE TOP OF THE WORLD
MOVE T2,HILN ;GET CURRENT
PUSHJ P,ASCAV ;FIND AVERAGE
CAME T2,HILN ;THERE MAY HAVE ONLY BEEN A DIF OF 1
JRST INCOK ;ALL IS WELL
NERROR ILR
INCOK: MOVEM T2,HILN
JRST INSLP
BEND INSERT
SUBTTL DELETE ROUTINE
BEGIN DELETE
;DELETA A LINE, A NUMBER OF LINES, OR A PAGE MARK
↑DELETE:SETZM LOLN ;JUST AS A START
TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
NERROR ILC
PUSHJ P,GET2S ;GET TWO PAGE-LINE PAIRS
TRNN FL,PGSN ;ONLY ON IF A SECOND PAGE SPEC
DELT1: TRNN FL,TERMF ;CHECK FOR TERMINATOR
NERROR ILC
TRZN FL,LINSN ;LINE NUMBER SEEN?
JRST DELPG ;NO, MUST BE /A. DELETE PAGE MARK A
MOVE T1,HIPG ;GET THE PAGE NUMBER
MOVEM T1,DPG
MOVE SINDEX,LOLN ;AND LINE
PUSHJ P,FIND
DELT2: CAME T1,PGMK ;ARE WE AT A PAGE MARK?
PUSHJ P,ONMOV ;CHECK FOR RANGE
JRST DELEND
MOVEM T1,CLN ;MARK AS CURRENT LINE
TRO FL,LINSN ;AND ALSO THAT WE DID SOMETHING
PUSHJ P,DODEL ;GO DO A LINE DELETE
PUSHJ P,FINDN1 ;FIND NEXT BUT ACCEPT LINE IF ALREADY THERE
JRST DELT2 ;GO DO NEXT
DELEND: TRNN FL,LINSN ;DID WE SEE ANYTHING?
NERROR NLN ;NO, GIVE ERROR
MOVE T1,CPG ;YES, SET CURRENT PAGE
MOVEM T1,CPGL
JRST COMND ;AND GET NEXT COMMAND
DELPG: MOVE T1,HIPG ;GET THE DESIRED PAGE TO DELETE
MOVEM T1,DPG ;SET IT
SOJLE T1,DELER ;DO NOT TRY PAGE 1
MOVEI SINDEX,0 ;GUARANTEED TO FIND LINE IMMEDIATELY AFTER PAGE MARK
PUSHJ P,FIND ;GET IT
MOVE T2,CPG ;CHECK FOR MATCH
CAME T2,HIPG
DELER: NERROR NSP ;NO SUCH PAGE
PUSHJ P,FINDB ;GO BACK ONE
CAME T1,PGMK ;IS IT A PAGE MARK?
ERROR ICN ;CONFUSED, GIVE FATEL ERROR
MOVEI T1,2 ;COUNT IS 2
MOVEM T1,OCNT
SETZM NCNT ;AND NEW IS 0
PUSHJ P,INSED
SOS BGPG ;MAX PAGE IS NOW 1 LOWER
SOS INPG
PUSHJ P,FINDN1 ;GET THE NEXT LINE
JUMPE T1,COMND ;IF EOF THERE IS NO ORDER ERROR
CAMN T1,PGMK ;OR IF A PAGE MARK
JRST COMND
MOVEM T1,SVWD3 ;SAVE IT FOR COMPARE
PUSHJ P,FINDB ;FIND THE PREVIOUS ONE
JUMPE T1,COMND ;START OF FILE, ALL OK
CAME T1,PGMK ;ANOTHER PAGE MARK
CAMGE T1,SVWD3 ;CHECK THE ORDER
JRST COMND ;ALL OK
NERROR ORDER ;ALL WRONG
↑DODEL: SETZM NCNT ;NEW IS 0
PUSHJ P,GETLTH ;OLD LENGTH
MOVEM T1,OCNT
JRST INSED ;GO INSERT AND RETURN
BEND DELETE
SUBTTL REPLACE ROUTINE
BEGIN REPLAC
↑REPLAC:SETZM LOLN ;I REALLY SHOULD PUT THIS ELSEWHERE
TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
NERROR ILC
PUSHJ P,GET2S ;WHAT DO WE WANT TO REPLACE?
CAIE C,"," ;HE CAN SPECIFY INCREMENT TOO
JRST CKTERM ;BUT HE DIDN'T, LOOK FOR TERMINATOR
PUSHJ P,SCAN ;GET INCR
TRNE FL,NUMF ;WHICH MUST BE A NUMBER
CAMN T1,[ASCID /00000/] ;NOT 0 FOR INCR
NERROR ILC
MOVEM T1,INCR
PUSHJ P,SCAN ;SCAN PAST
CKTERM: TRNN FL,PGSN ;WAS A SECOND PAGE GIVEN?
TRNN FL,TERMF ;OR PERHAPS NO TERMINATOR
NERROR ILC
MOVE T1,LOPG ;FIND START OF THE WORLD
MOVEM T1,DPG
MOVE SINDEX,LOLN
PUSHJ P,FIND ;WE WILL ALSO USE LOLN FOR START OF INSERT
SKIPN LOLN ;IN CASE HE SAID /A OR SOMETHING
MOVEM T1,LOLN ;USE START OF PAGE
MOVE T2,CPG ;GET CURRENT PAGE
CAME T2,LOPG ;AND FIND OUT IF ITS THE ONE WE WANT
NERROR NSP
NEXT: CAME T1,PGMK ;PAGE MARK STOPS THE WORLD
PUSHJ P,ONMOV ;CHECK RANGE
JRST GOINS ;OUT OF THINGS TO DELETE, INSERT
PUSHJ P,DODEL ;DELETE A LINE
SKIPE T1,(PNTR) ;ARE WE AT END OF BUFFER
JRST NEXT ;NO
NEXT1: MOVE T1,WC ;SEE IF ROOM TO INSERT
ADD T1,BUFP
CAML T1,FILPT
JRST NXTBF ;TOO FULL, GET NEXT BUFFER AND DELETE
SETZM OCNT ;INSERT A FRESH LINE
MOVE T1,LOLN ;THE LINE TO INSERT
MOVEM T1,LIBUF
PUSHJ P,OUTSN
PUSHJ P,RDLIN ;GET ONE
JRST FINDL ;LINE TOO LONG ERROR
MOVEM T1,NCNT ;SET UP NEW COUNT
PUSHJ P,INSED ;INSERT
PUSHJ P,FINDZ ;GET NEXT LINE, BUT NOT IN NEW BUFFER
MOVE T1,CPG ;SET UP .
MOVEM T1,CPGL
MOVE T1,LOLN
MOVEM T1,CLN
MOVE T2,INCR ;FIND NEXT LINE
PUSHJ P,ASCIAD
CAMG T1,INCR ;CHECK FOR WRAP AROUND
JRST FINDEL
MOVEM T1,LOLN ;AND SAVE IT
JRST NEXT1 ;CHECK TO SEE IF INSERT OR DELETE IN ORDER
GOINS: SKIPE T2,LOLN ;IS THERE REALLY ONE THERE?
CAMN T2,PGMK
JRST COMND ;TRIED TO REPLACE BLANK PAGE
MOVEM T2,HILN ;SET UP FOR INSERT
JRST ENTINS ;AND JUMP INTO THE MIDDLE OF IT
FINDL: MOVE T1,LOLN
MOVEM T1,CURINS
MOVE T1,CPG
MOVEM T1,IPG
FINDEL: PUSHJ P,FINDN1 ;GET THE NEXT LINE
CAME T1,PGMK ;QUIT IF PAGE MARK
PUSHJ P,ONMOV ;OR IF OUT OF RANGE
JRST LEVINS
PUSHJ P,DODEL ;DELETE IT
JRST FINDEL
NXTBF: PUSHJ P,FINDN1 ;GET TO A NEW BUFFER IF NECESSARY
JRST NEXT ;AND PROCEED TO NEXT
BEND REPLAC
SUBTTL JOIN ROUTINE
BEGIN JOIN ;CONNECT TWO LINES TOGETHER
↑JOIN: MOVEM C,SAVC ;BACK UP SCANNER ONE CHARACTER
PUSHJ P,GET1S ;GET LINE NUMBER
TRNN FL,TERMF
NERROR ILC
MOVE T1,HIPG
MOVEM T1,DPG
MOVE SINDEX,HILN ;FIND THE CORRECT LINE
PUSHJ P,FIND
MOVE T2,CPG
MOVE T1,(PNTR)
CAMN T2,HIPG
CAME T1,HILN
NERROR NLN
MOVEM T2,CPGL
MOVEM T1,CLN
SETZM LIBUF ;TO ELIMINATE GARBAGE AT END OF LINE
MOVE T1,[XWD LIBUF,LIBUF+1]
BLT T1,LIBUF+MXWPL+1
MOVE T2,PNTR ;GET THE POINTER TO THE LINE
MOVE T3,(T2) ;PICK UP THE FIRST WORD
MOVEI T4,LIBUF ;THE PLACE TO PUT IT
JRST SALT3 ;TRANSFER
SALT2: SKIPE T3,(T2)
TRNE T3,1 ;IS IT THE END OF THE LINE
JRST SALT1
SALT3: MOVEM T3,(T4) ;PUT IT AWAY
ADDI T4,1
AOJA T2,SALT2
SALT1: MOVEI T1,-LIBUF(T4)
MOVEM T1,OCNT
IMULI T1,5 ;GET COUNT OF CHRS
SUBI T1,6 ;WE WILL HAVE TO FIND THE TRUE END
SUBI T4,2
HRLI T4,(<POINT 7,0,27>) ;SET UP POINTER
FEND1: ILDB T2,T4
CAIE T2,15
AOJA T1,FEND1
PUSH P,T1
PUSHJ P,FINDN ;GET THE LINE TO JOIN IT TO
CAME T1,PGMK
SKIPN T1
NERROR NNN ;NO LINE THERE TO CONNECT TO
POP P,T2 ;COUNT
MOVEI T1,1(PNTR)
HRLI T1,(<POINT 7,0,6>) ;SET TO POINT THERE
ADD T4,[XWD 70000,0]
TRN1: ILDB T3,T1
IDPB T3,T4
ADDI T2,1
CAIL T2,MXWPL*5+6
NERROR LTL
CAIE T3,12
JRST TRN1
SUBI T1,-1(PNTR)
PUSH P,OCNT
HRRZM T1,OCNT ;SIZE OF OLD SECOND LINE
SETZM NCNT
PUSHJ P,INSED
PUSHJ P,FINDB ;BACK UP
POP P,OCNT ;GET ITS SIZE
SUBI T4,LIBUF-1
HRRZM T4,NCNT
PUSHJ P,INSED
JRST COMND
BEND JOIN
SUBTTL ALTER ROUTINES
BEGIN ALTER
IFN STANSW,<
↑QPAND: SKIPA T1,[PUSHJ P,QLIN] ;EXPAND LINE USING SYSTEM EDITOR
↑ZALT: MOVE T1,[PUSHJ P,ZLIN] ;ALTER LINE USING SYSTEM EDITOR
TRNN FL,DPYF ;ILLEGAL IF NOT A DPY
>
IFE STANSW,<
↑ZALT: ↑QPAND:
>
NERROR ILC ;FOR WHATEVER REASON
IFN STANSW,<
JRST ALT111 ;CONTINUE
>
↑XPAND: SKIPA T1,[PUSHJ P,XTEND] ;EXPAND LINE USING INTERNAL EDITOR
↑ALTER: MOVE T1,[PUSHJ P,ALTLIN] ;ALTER LINE USING INTERNAL EDITOR
ALT111: MOVEM T1,ZSW ;FOR LATER EXECUTION
SETZM LOLN ;FOR START OF PAGE
TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
NERROR ILC
PUSHJ P,GET2S ;GET THE RANGE
TRNN FL,TERMF ;CHECK FOR PROPER END
NERROR ILC ;UNEND
MOVE T1,LOPG ;START TO PROCESS
MOVEM T1,DPG
MOVE SINDEX,LOLN
PUSHJ P,FIND ;GO GET IT
TRZ FL,LINSN ;NOT SEEN YET
ALT1: PUSHJ P,ONMOV ;CHECK FOR IN RANGE
JRST ALT2 ;NO, FINISH UP
TRO FL,LINSN ;WE DID SEE SOMETHING
CAMN T1,PGMK ;CHEC FOR A PAGE
JRST ALT3 ;DO NNT TRY TO CHANGE THIS
MOVEM T1,CLN ;NOW, IN CASE WE SAID ALTMODE
MOVE T1,CPG ;SAME FOR PAGE
MOVEM T1,CPGL
XCT ZSW ;CALL ALTLIN OR ZLIN
JRST LEVINS ;HE SAID ALTMODE
PUSHJ P,INSED ;GO INSERT
ALT4: PUSHJ P,FINDN ;GET THE NEXT LINE
PUSHJ P,FILLB ;AND CHECK FOR BUFFER OVERFLOW
MOVE T1,(PNTR) ;GET LINE FOR ONMOV
JRST ALT1 ;CONTINUE LOOP
ALT3: AOS T2,CPG ;WE ARE ON A LATER PAGE NOW
MOVEM T2,CPGL ;SAVE AS .
PUSHJ P,PGPRN ;PRINT HIM A MESSAGE
MOVE T1,[ASCID /00000/] ;SET TO FIRST? LINE
MOVEM T1,CLN ;FOR .
JRST ALT4 ;CONTINUE PAST IT
ALT2: TRNN FL,LINSN ;WAS THERE ANYTHING THERE?
NERROR NLN ;NO, GIVE ERROR
MOVE T1,CPG ;GET CURRENT PAGEE
MOVEM T1,CPGL ;SAVE AS .
JRST COMND ;GO
BEND ALTER
BEGIN ALTLIN
↑XTEND: PUSHJ P,SETALT ;SET UP LINE FOR ALTERATION
MOVSI T2,1 ;VERY LARGE NUMBER
PUSHJ P,ALTSP ;SPACE OUT TO END
MOVEI T2,0 ;ZERO INCREMENT TO START
PUSHJ P,ALTIN ;INSERT REST OF LINE
JRST ALTN1 ;CONTINUE ALTERATION
↑ALTLIN:PUSHJ P,SETALT ;SET UP LINE FOR ALTERATION
↑ALTN1: IFE FULDPX,<MOVE T1,[POINT 7,DDTINB] ;SET UP FOR DDT FETCH
MOVEM T1,DDTINP ;INTO POINTER
SETZM DDTINB ; TO INSURE A FETCH THE FIRST TIME>
ALTLP2: MOVEI T2,0 ;ZERO REPEAT COUNT
ALTLP: TRZ FL2,ALTDUP ;TURN DUPLEXING BACK OFF
PUSHJ P,GNCH1 ;GET ON CHR IN DDT SUBMODE
TLNE CS,LETF⊗16 ;CHECK FOR LETTER
TRZ C,40 ;AND CONVERT TO UPPER CASE
MOVSI T1,-ALTLG ;GET LENGTH OF COMMAND TABLE
CAME C,ALTAB1(T1) ;CHECK FOR EQUAL
AOBJN T1,.-1 ;NO, TRY AGAIN
JUMPGE T1,ALTLP2 ;AOBJN RAN OUT, IGNORE
PUSHJ P,@ALTAB2(T1) ;EXECUTE COMMAND
JRST ALTLP2 ;RESET REPEAT COUNT AND GET NEW COMMAND
JRST ALTLP ;SKIP RETURN FROM DIGITS NO COUNT RESET
ALTAB1: " "↔"I"↔"D"↔"S"↔"K"↔"Q"↔12↔"C"↔177↔"U"-100
"R"↔"L"↔"P"↔"J"↔"0"↔"1"↔"2"↔"3"↔"4"↔"5"↔"6"↔"7"↔"8"↔"9"↔"0"
ALTLG←.-ALTAB1
ALTAB2: ALTSP↔ALTIN↔ALTDL↔ALTSR↔ALTKL↔ALTALT↔ALTFN↔ALTCN
ALTBS↔ALTCU↔ALTRP↔ALTLN↔PRINT↔JOIN
REPEAT =10,<ALTDG>
IFN STANSW,<
↑QLIN: PUSHJ P,SETALT ;GET READY FOR LINE
TROA FL2,ALTDUP ;WILL SPACE TO END AFTER LINE LOADED
↑ZLIN:
PUSHJ P,SETALT ;SET UP FOR LINE ALTERATION
↑ZLNN1: TTYUUO 11, ;CLEAR OUT SYSTEM INPUT BUFFER
OPDEF PTYUUO [711B8] ;FOR COMMUNICATING WITH SYSTEM
MOVNI T1,1
TTCALL 6,T1 ;GET CHARACTERISTICS
HLRS T1 ;COPY BITS TO RIGHT HALF(SAVE)
TLO T1,20 ;PRESERVE LOWER CASE
TTCALL 7,T1 ;IF THERE
HRLZS T1 ;RIGHT GOES TO LEFT
PTYUUO 15,[0
POINT 7,LIBUF+1,6] ;LINE →SYSTEM (WITHOUT TAB)
TRZE FL2,ALTDUP ;SHOULD WE GO TO END?
PTYUUO 7,[0
211] ;YES, SEND [CTRL1] TAB
TRZE FL2,ZSPA ;WANT TO SPACE OUT?
JRST [CTSP: PTYUUO 7,[0
240] ;YES, PUT OUT CTRL SPACES
SOJGE T2,CTSP ;UNTIL DONE
JRST .+1]+1
TTCALL 7,T1 ;PUT OLD MODE BACK
SETZM LIBUF+1 ;NOW CLEAR WHAT HAS BECOME AN
MOVE T1,[XWD LIBUF+1,LIBUF+2] ;INPUT BUFFER
BLT T1,LIBUF+MXWPL+1
MOVE ALTP,[POINT 7,LIBUF+1,6];FOR DEPOSITING
; MOVE ALTP,[POINT 7,LIBUF+1];FOR DEPOSITING
; MOVEI T1,177 ;NON-PRINTER REPLACES TAB TEMPOR.
; IDPB T1,ALTP
TTCALL 14,T3 ;WAIT FOR ACTIVATION, GET LINE COUNT
MOVE T2,T3 ;SAVE TOTAL COUNT
SETZM SVCRLC ;ASSUME NO INSERTION OF CR
SETSTS TTY,401 ;TURN ON DUPLEXING AGAIN
ZLUP: TTCALL T1 ;NEXT CHAR BACK FROM THE WARS
CAIN T1,412 ;INSERTING A CR?
JRST [MOVEM ALTP,SVCRLC ;SAVE BP WHERE CR OCCURRED
IBP SVCRLC ;ACTUALLY THE NEXT
SUB T2,T3 ;COMPUTE #CHARS MOVED
MOVEM T2,ALTCNT ;THIS IS WHERE `A' CODE EXPECTS
JRST .+1] ;CONTINUE
TRZ T1,600 ;TURN OFF CONTROL BITS, IF ANY
CAIE T1,12 ;IGNORE CR-LF PAIRS
CAIN T1,15
JRST LUPTRM ;LIKE THIS
IDPB T1,ALTP
CAIN T1,175 ;ALTMODE?
JRST [TTCALL 11, ;YES, GET OUT
POPJ P,]
LUPTRM: SOJG T3,ZLUP ;GET ALL THE CHARACTERS
ZDUN: MOVEI T1,15
IDPB T1,ALTP
MOVEI T1,12 ;PUT CR-LF IN BY HAND
IDPB T1,ALTP
SKIPE SVCRLC ;WAS THERE A CTRL2 CR?
JRST ZINSCR ; YES, INSERT CRLF
; TTYUUO 3,LIBUF+1 ;NOW TYPE THE (NEW) LINE
MOVEI T1,[ SIXBIT/TTY/
POINT 0,LIBUF+1,6] ;NEW TTYMES METHOD
CALLI T1,400047 ;NEW FORM OF TTYMES, POSITION FIELD
JFCL ; IF YOU LOSE, YOU LOSE
MOVEI T1,11 ;PUT IN IMPLIED TAB
DPB T1,[POINT 7,LIBUF+1,6]
; ABOVE WAS DONE SO THAT INSERTING A CARRIAGE RETURN IN
; `Z' MODE WOULDN'T LOOK FUNNY (WE DO THE DUPLEXING, SO
; WE HAVE CONTROL -- RECOGNIZE THAT?)
SUBI ALTP,LIBUF-1 ;LINE LENGTH FOR INSED
HRRZM ALTP,NCNT
AOS (P) ;SKIP RETURN
POPJ P,
ZINSCR: SETOM ZCOMMND ;TELL COMMON CODE WHO CALLED
SETZM ALTINC ;USE STANDARD INCR
MOVE ALTP,SVCRLC ;BP WHEN CR WAS INSERTED
JRST INSCR1 ;USE COMMON CODE TO INSERT
>
BEGIN SETALT
↑SETALT: SETZM LIBUF ;ZERO OUT INTERNAL LINE BUFFER
MOVE T1,[XWD LIBUF,LIBUF+1]
BLT T1,LIBUF+MXWPL+1
MOVEI T1,LIBUF ;SET POINTER TO TRANSFER
MOVE T2,PNTR
MOVE T3,(T2) ;GET THE FIRST WORD (SEQ NUM)
JRST SALT3
SALT2: SKIPE T3,(T2) ;PICK UP A WORD AND CHECK FOR 0
TRNE T3,1 ;CHECK FOR SEQ NTM
JRST SALT1 ;END OF THIS LINE
SALT3: MOVEM T3,(T1) ;SAVE IT AWAY
ADDI T1,1 ;INCREMENT POINTERS
AOJA T2,SALT2
SALT1: MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP POINTER
SETZM ALTCNT ;SO FAR WE ARE 0 CHRS INTO LINE
SUBI T1,LIBUF ;GET COUNT OF OLD LINE
HRRZM T1,OCNT ;AND SAVE IT FOR INSED
IFN FULDPX,<IFN STANSW,<SETSTS TTY,601>
IFE STANSW,<SETSTS TTY,201 ;TURN OFF DUPLEXING>
TRZ FL2,RUBF!ALTDUP!RUBF2 ;TURN OFF IN RUBOUT FALG AND NO DUPLEXING>
IFE FULDPX,< CALLI 400001
TRZ FL2,ALTDUP>
SETZM ALTFLG ;NOTHING INSERTED SO FAR
MOVE T1,LIBUF ;PRINT LINE NUMBER AND TAB
JRST OUTSN
BEND SETALT
↑SETALT←SETALT
IFN FULDPX,<
DEFINE OFFRUB
< TRZE FL2,RUBF2
TTYUUO 3,[ASCII /\\/]
TRZE FL2,RUBF
TTYUUO 1,["\"]>>
IFE FULDPX,<
DEFINE OFFRUB <>>
IFN FULDPX,<
DEFINE ONRUB
< TRZE FL2,RUBF2
TTYUUO 3,[ASCII /\\/]
TRON FL2,RUBF
TTYUUO 1,["\"]>>
IFE FULDPX,<DEFINE ONRUB<>>
BEGIN GNCH1
IFE FULDPX,<GNCH1A: ILDB C,DDTINP ;GET A CHR IN DDT MODE (1 FROM BUFFER)
JUMPN C,GNCH1C ;IF NOT 0 IT IS OK
MOVE C,[POINT 7,DDTINB] ;0 MUST BE OUT, GET MORE
MOVEM C,DDTINP
CALLI C,1 ;DDTIN WILL USE RH=DDTINB FOR INPUT
JRST GNCH1A ;NOW GO GET A CHARACTER>
IFN FULDPX,<GNCH1A: TTYUUO 0,C
ANDI C,177>
GNCH1C: CAIE C,175 ;NEVER DUPLEX ALTMODE
TRNN FL2,ALTDUP ;AND NOT UNLESS DESIRED
POPJ P,
CAIE C,12 ;NOT LINE FEED
CAIN C,15 ;OR RETURN
POPJ P,
CAIN C,177 ;AND FINALLY IGNORE RUBOUT
POPJ P,
OFFRUB ;IF WE ARE DUPLEXING WE ARE NOT DELETING
IFN FULDPX,<TTYUUO 1,C ;TYPE>
IFE FULDPX,<SETZM SQBUF ;AS GOOD A PLACE AS ANY
DPB C,[POINT 7,SQBUF,6]
PUSH P,C
MOVEI C,SQBUF
CALLI C,3
POP P,C>
POPJ P,
↑GNCH1: PUSHJ P,GNCH1A ;GET A CHR IN DDT MODE
CAIN C,175 ;CONVERT ALTMODE TO 200
MOVEI C,200
TLNN FL,QMODF
CAIE C,"?" ;CHECK FOR QUESTION MARK
JRST GNCH1B ;NO, THIS CHR IS OK
PUSHJ P,GNCH1A ;GET ANOTHER
SKIPE CTBL(C) ;IF 0 HN CTBL, KEEP IT
MOVS C,CTBL(C) ;GET ALTERNATE CODE
ANDI C,177 ;GET RID OF EXTRA BITS
GNCH1B: MOVE CS,CTBL(C) ;LOAD CS
TLNE CS,LETF⊗16 ;CHECK FOR LETTER
TDC C,CASEBT ;AND APPLY CASE CONVERRION
POPJ P, ;ALL DONE
BEND GNCH1
ALTDG: IMULI T2,=10 ;ACCUMULATE REPEAT COUNT
ADDI T2,-"0"(C)
AOS (P) ;SKIP RETURN SO AS NOT TO 0 RPT. CNT.
POPJ P,
↑ALTSP: OFFRUB
BEGIN ALTSP
ALTSP2: LDB C,ALTP ;GET THE CHR WE ARE POINTING AT
CAIN C,15 ;IF RETURN THEN AS FAR AS CAN GO
JRST ALTSP1 ;SO QUIT
PUSHJ P,OCHR ;PRINT IT
IBP ALTP ;ADVANCE POINTER
AOS ALTCNT ;AND COUNT
SOJG T2,ALTSP2 ;DO CORRECT NUMBER OF TIMES
ALTSP1: OUTPUT TTY,0 ;FORCE IT OUT
POPJ P,
BEND ALTSP
BEGIN ALTIN
↑ALTIN: TRO FL2,ALTDUP ;TURN ON DUPLEXING
MOVEM T2,ALTINC ;SAVE IN CASE HE INSERTS A RETURN
ALTIN1: PUSHJ P,GNCH1 ;GET A CHARACTER
CAIN C,15 ;IGNORE RETURN
JRST ALTIN1
CAIN C,12 ;FINISH ON LINE FEED OR ALTMODE
JRST INSCR ;GO INSERT A CRLF
CAIN C,200
POPJ P, ;GO AWAY
CAIN C,177 ;CHECK FOR BACKSPACE
JRST ALTIBS ;AND DELETE CHR TO LEFT
MOVE T3,ALTP ;GET SET TO SHIFT THINGS
PUSH P,ALTCNT ;SAVE THIS FOR LATER
LDB T1,T3 ;GET CHR FROM LINE
ALTIN2: DPB C,T3 ;SHIFT LINE
JUMPE C,ALTIN3 ;DONE
AOS ALTCNT ;COUNT IT
ILDB C,T3
DPB T1,T3
JUMPE T1,ALTIN3 ;DONE
AOS ALTCNT ;COUNT
ILDB T1,T3
JRST ALTIN2
ALTIN3: MOVE T2,ALTCNT ;SEE IF OVERFLOW HAPPENED
CAIL T2,MXWPL*5
NERROR LTL ;YES
POP P,ALTCNT ;RESTORE OLD COUNT
IBP ALTP ;ADVANCE POINTER
AOS ALTCNT ;AND COUNT
JRST ALTIN1 ;GO GET MORE
INSCR: OFFRUB
SETZM ZCOMMND ;NOT CALLED FROM `Z' COMMAND
TERPRI (T1)
↑INSCR1:
SKIPN T1,ALTINC ;DID HE SPECIFY AN INCREMENT?
SKIPA T3,INCR ;NO, USE STANDARD
PUSHJ P,ASCON ;CONVERT TO ASCII
MOVE T1,T3 ;FIND THE NEW LINE NUMBER
MOVE T2,LIBUF ;CURRENT ONE
PUSHJ P,ASCIAD ;ADD
PUSH P,T1 ;SAVE RESULT
PUSHJ P,FINDN ;GET THE NEXT ONE
POP P,T2
CAMG T2,LIBUF ;IS THERE A WAR PROBLEM
JRST INCBAD ;YES, WE MUST TRY TO COMPUTE ONE
JUMPE T1,INCOK ;END OF FILE, ANY INC IS OK
CAME T1,PGMK ;ALSO OK IF A PAGE MARK
CAMGE T2,T1 ;OR IN CORRECT ORDER
JRST INCOK
INCBAD: CAME T1,PGMK
SKIPN T1
MOVE T1,[ASCID /9999:/] ;ONE OVER THE TOP OF THE WORLD
MOVEM T2,LIBUF2 ;SAVE IN CASE NOTHING WILL WORK
MOVE T2,LIBUF ;GET CURRENT
PUSHJ P,ASCAV ;FIND AVERAGE
CAME T2,LIBUF ;THERE MAY HAVE ONLY BEEN A DIF OF 1
JRST INCOK ;ALL IS WELL
RERROR ORDER ;TELL HIM
PUSHJ P,FINDB ;GET BACK WHERE WE BELONG
SKIPE ZCOMMND ;WERE WE IN Z MODE?
JRST ZERCOR ; YES
PUSHJ P,ERCOR ;TYPE OUT LINE TO CURRENT POINT
JRST ALTIN1 ;AND CONTINUE INSERT
ZERCOR: TERPRI (T1) ;NOW PRINT CRLF
TRO FL2,ZSPA ;SPACE OUT N
PUSH P,ALTCNT ;WILL BE ZEROED BY SETALT
PUSHJ P,SETALT ;SET UP FOR ALTER AGAIN
POP P,T2 ;THIS IS N
SOJA T2,ZLNN1 ;GO BACK AND TRY AGAIN
INCOK: MOVEM T2,LIBUF2 ;SAVE IT
MOVEM T2,CLN ;AND SET AS CURRENT LINE
PUSHJ P,FINDB ;BACK UP TO WHERE WE BELONG
MOVE T1,[XWD LIBUF+1,LIBUF2+1]
BLT T1,LIBUF2+MXWPL+1 ;SAVE OLD BUFFER
PUSH P,ALTP ;SAVE POINTER
MOVEI C,15
DPB C,ALTP ;AND TERMINATE THIS LINE
MOVEI C,12
IDPB C,ALTP
MOVEI C,0 ;FILL OUT LINE WITH NULLS
INSC2: TLNN ALTP,760000
JRST INSC3
IDPB C,ALTP
JRST INSC2
INSC3: SKIPN ZCOMMND ;IN Z MODE?
JRST INSC33 ; NO
; TYPE OUT LINE, REPLACE 177 WITH TAB
SETZM 1(ALTP) ;MAKE SURE THERE'S A NULL
MOVEI T1,[ SIXBIT/TTY/
POINT 0,LIBUF+1,6];NEW TTYMES USES POSITION FIELD
CALLI T1,400047 ;TTYMES, FROM 2D CHAR
JFCL ;IGNORE LOSSAGE (SHOULDN'T HAPPEN)
; TTYUUO 3,LIBUF+1 ;TYPE WHAT IS THERE
MOVEI C,11 ;PUT TAB IN
DPB C,[POINT 7,LIBUF+1,6]
INSC33: SUBI ALTP,LIBUF-1 ;FIND COUNT
HRRZM ALTP,NCNT
PUSHJ P,INSED ;REPLACE OLD LINE
PUSHJ P,FINDN ;MOVE UP TO NEXT
PUSHJ P,FILLB ;AND DUMP IF OVERFLOW
SETZM OCNT ;THIS IS A NEW LINE GOING IN
MOVE T1,LIBUF2 ;MOVE LINE NUMBER OVER
MOVEM T1,LIBUF
SETZM LIBUF+1
MOVE T1,[XWD LIBUF+1,LIBUF+2]
BLT T1,LIBUF+MXWPL+1 ;ZERO OUT REST
POP P,T2 ;RESTORE POINTER TO REST OF LINE
MOVE ALTP,[POINT 7,LIBUF+1] ;DEST POINTER
ADD T2,[XWD 70000,LIBUF2-LIBUF] ;ADJUST INPUT POINTER
MOVEI C,11 ;AND SET UP THE TAB
MOVNEW: IDPB C,ALTP
CAIN C,12
JRST DONNEW ;FINISHED MOVING REST OF LINE
ILDB C,T2 ;PICK UP ONE
JRST MOVNEW
DONNEW: MOVEI ALTP,1-LIBUF(ALTP) ;GET COUNT
MOVEM ALTP,NCNT
PUSH P,ALTP ;AND SAVE
PUSHJ P,INSED ;INSERT
MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP FOR ALTER
SETZM ALTCNT
POP P,OCNT ;SET FOR OLD COUNT
SKIPE ZCOMMND ;FROM Z COMMAND?
JRST ZLIN ; YES, GO ALTER THIS LINE
MOVE T1,LIBUF
PUSHJ P,OUTSN
SETOM ALTFLG ;WE HAVE INSERTED AND ALTALT SHOULD CALL FILLB
JRST ALTIN1 ;AND CONTINUE INSERTING
POPJ P,
ALTIBS: MOVEI T2,0 ;SET COUNT TO 0
MOVEM ALTP,SVALTP ;SAVE POINTER
PUSHJ P,ALTBS ;DO A BACKSPACE
EXCH ALTP,SVALTP ;GET BACK AND SAVE CURRENT
PUSHJ P,ALTDL3 ;DELETE THAT CHR
JRST ALTIN1 ;GET MORE
BEND ALTIN
↑ALTIN←ALTIN
BEGIN ALTDL
↑ALTDL: MOVEM ALTP,SVALTP ;SAVE CURRENT POINTER POSITHON
ALTDL1: LDB C,ALTP ;GET CURRENT CHR
CAIN C,15 ;AT END OF LINE?
JRST ALTDL5 ;YES, GO FINISH OFF
CAIG T2,3 ;FEWER THAN 3 MORE TO DELETE
IFE FULDPX,<JRST [PUSHJ P,OCHR ;PRINT IT
MOVEI C,"\" ;AND A \
PUSHJ P,OCHR
JRST .+1]>
IFN FULDPX,<JRST [PUSH P,C
MOVEI C,"\"
TRNN FL2,RUBF2
PUSHJ P,OCHR
TRZE FL2,RUBF
PUSHJ P,OCHR
TRON FL2,RUBF2
PUSHJ P,OCHR
POP P,C
PUSHJ P,OCHR
JRST .+1]>
IBP ALTP ;ADVANCE POINTER
SOJG T2,ALTDL1 ;CHECK COUNT AND CONTINUE
ALTDL5: OUTPUT TTY,0 ;FORCE OUTPUT
↑ALTDL3:MOVE T3,SVALTP ;GET BACK POINTER
ALTDL4: LDB C,ALTP ;MOVE LINE DOWN
DPB C,T3
JUMPE C,ALTDL2 ;DONE?
IBP ALTP ;ADVANCE POINTERS
IBP T3
JRST ALTDL4
ALTDL2: MOVE ALTP,SVALTP ;RESTORE POINTER AGAIN
POPJ P, ;AND LEAVE
BEND ALTDL
PRINT: PUSH P,ALTCNT ;SAVE CURRENT COUNT
PUSHJ P,ALTLN ;PRINT REST OF LINE AND START OVER
POP P,T2 ;GET BACK COUNT
CAILE T2,0 ;AND SPACE IF NOT 0
JRST ALTSP
POPJ P,
BEGIN ALTSRC
↑ALTSR: OFFRUB
PUSHJ P,GNCH1 ;GET THE CHARACTER TO SEARCH FOR
ALTSR1: PUSH P,T2 ;SAVE NUMBER OF TIMES TO SEARCH
PUSHJ P,ALTCS ;CALL COMMON SEARCH ROUTINE
PUSH P,C ;SAVE THE CHARACTER
PUSHJ P,ALTSP ;GO SPACE CORRECT NUMBER
POP P,C ;RESTORE CHR
POP P,T2 ;AND COUNT
SOJG T2,ALTSR1 ;CONTINUE
POPJ P,
ALTCS: MOVEI T2,1 ;CREATE A REPEAT COUNT
LDB T3,ALTP ;CHECK TO SEE IF AT END OF LINE
CAIN T3,15
POPJ P,
MOVE T1,ALTP ;GET A COPY OF THE POINTER
ALTCS1: ILDB T3,T1 ;GET A CHARACTER
CAIE T3,15 ;DONE IF END OF LINE
CAMN T3,C ;OR A MATCH
POPJ P,
AOJA T2,ALTCS1 ;ELSE KEEP COUNT AND KEEP LOOKING
↑ALTKL: PUSHJ P,GNCH1 ;ALMOST LINE ALTSR
ALTKL1: PUSH P,T2
PUSHJ P,ALTCS
CAIN T3,15 ;BUT GIVE UP IF CHR NOT FOUND
JRST TPOPJ
PUSH P,C
PUSHJ P,ALTDL ;DELETE THAT NUMBER
POP P,C
POP P,T2
SOJG T2,ALTKL1
POPJ P,
↑TPOPJ: POP P,T2 ;NEED TO CLEAR STACK
POPJ P,
BEND ALTSRC
; "Q" -- IGNORE THIS LINE
; (RATHER, IGNORE ANY CHANGES TO IT)
ALTALT: OFFRUB
SKIPN ALTFLG ;SHOULD WE DO A FILLB?
JRST ALTAL1
PUSHJ P,FINDN
PUSHJ P,FILLB ;YES, WE HAVE INSERTED SOMETHING
IFN FULDPX,<ALTAL1:IFN STANSW,<SETSTS TTY,401>
IFE STANSW,<SETSTS TTY,1 ;DUMPLEXING BACK ON>>
IFE FULDPX,<ALTAL1: CALLI 400001>
JRST TPOPJ ;AND RETURN
BEGIN ALTFN
↑ALTFN: OFFRUB
MOVEI T2,1000 ;FINISH UP LINE
PUSHJ P,ALTSP ;BY PRINTING A LARGE NUMBER OF SPCAES
TERPRI (T1)
IFN FULDPX,<IFN STANSW,<SETSTS TTY,401>
IFE STANSW,<SETSTS TTY,1 ;GET OUT OF NON-DUPLEX MODE>>
IFE FULDPX,< CALLI 400001>
ALTFN1: ILDB C,ALTP ;LOOK ONE CHR OVER
CAIE C,12 ;THIS SHOULD BE THE LINE FEED
NERROR ILFMT ;SOMETHING IS WRONG
MOVEI C,0 ;ZERO REMAINDER OF LINE
ALTFN2: TLNN ALTP,760000 ;ALL DONE?
JRST ALTFN3 ;YES
IDPB C,ALTP ;NO, PUT IN ANOTHER 0
JRST ALTFN2
ALTFN3: SUBI ALTP,LIBUF-1 ;GET SIZE OF NEW LINE
HRRZM ALTP,NCNT ;AND SAVE FOR INSED
AOS -1(P) ;SET FOR SKIP RETURN
POP P,T1 ;GET RID OF THE EXTRA CALL
POPJ P, ;RETURN TO CALLER OF ALTLIN
BEND ALTFN
ALTCU: OFFRUB
IFEDUPL {CALLI 400001}
MSSG (T1,<↑U
>)
JRST SETALT ;GO RESTART LINE AND FORGET EDIT SO FAR
ALTRP: PUSHJ P,ALTDL ;REPLACE IS DELETE THEN INSERT
MOVEI T2,0
JRST ALTIN
BEGIN ALTCN
↑ALTCN: OFFRUB
TRO FL2,ALTDUP ;TURN ON DUPLEXING
ALTCN2: LDB C,ALTP ;AT END OF LINE?
CAIN C,15
POPJ P, ;YES, STOP
ALTCN1: PUSHJ P,GNCH1 ;GET A CHARACTER
CAIE C,177 ;DO NOT LET HIM INSERT A RUBOUT
CAIN C,12 ;IGNORE CRET
JRST ALTCN1
CAIE C,200 ;STOP ON ALTMODE AND LINE FEED
CAIN C,15
POPJ P,
DPB C,ALTP ;REPLACE IT
IBP ALTP ;ADVANCE POINTER
AOS ALTCNT ;AND COUNT
SOJG T2,ALTCN2 ;CONTINUE
POPJ P,
BEND ALTCN
BEGIN JOINA
↑JOIN: OFFRUB
PUSHJ P,FINDN ;GO SEE IF NEXT LINE IS REALLY THERE
CAME T1,PGMK
SKIPN T1
JRST ILCER ;MAKE IT ILLEGAL IF NO LINE THERE
MOVEM T1,LIBUF2 ;SAVE ITS NUMBER
SETZM LIBUF2+1
MOVE T1,[XWD LIBUF2+1,LIBUF2+2]
BLT T1,LIBUF2+MXWPL+1 ;CLEAR OUT REST OF BUFFER
PUSH P,ALTP ;SAVE POINTER TO THIS LINE
ADD ALTP,[XWD 70000,0] ;BACK IT UP
MOVE T2,[POINT 7,LIBUF2+1]
MOVEI C,11
MOVEI T1,6 ;COUNT THE CHARACTERS
MOVLIN: IDPB C,T2
ILDB C,ALTP
CAIE C,15 ;END OF LINE?
AOJA T1,MOVLIN ;KEEP COUNT
MOVEI ALTP,1(PNTR) ;GET POINTER TO SECOND LINE
HRLI ALTP,(<POINT 7,0,6>)
TRN1: ILDB C,ALTP
IDPB C,T2
ADDI T1,1
CAIL T1,MXWPL*5+6 ;CHECK SIZE
JRST LTLER
CAIE C,12
JRST TRN1 ;NOT DONE YET
EXCH T2,(P) ;SAVE OUTPUT POINTER AND GET OLD ALTP BACK
SUBI ALTP,-1(PNTR) ;GET OLD COUNT OF SECOND LINE
PUSH P,ALTP ;AND SAVE IT
MOVEI C,15 ;FINISH CURRENT LINE
DPB C,T2
MOVEI C,12
IDPB C,T2
MOVEI C,0
INSC2: TLNN T2,760000
JRST INSC3 ;FILL WITH NULLS
IDPB C,T2
JRST INSC2
INSC3: SUBI T2,LIBUF-1 ;GET COUNT
HRRZM T2,NCNT
PUSHJ P,FINDB ;BACK UP TO POINT TO IT
PUSHJ P,INSED
PUSHJ P,FINDN
PUSHJ P,FILLB
POP P,OCNT ;OLD CONT
HRRZS OCNT
POP P,ALTP ;GET OUTPUT POINTER BACK
SUBI ALTP,LIBUF2-1
HRRZM ALTP,NCNT
MOVE T1,[XWD LIBUF2,LIBUF]
BLT T1,LIBUF+MXWPL+1
PUSHJ P,INSED
SETOM ALTFLG ;MARK AS NEED TO DO FILLB
MOVE T1,NCNT ;GET THE COUNT JUST USED
MOVEM T1,OCNT ;AND SET AS THE OLD COUNT
MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET UP
SETZM ALTCNT
TERPRI (T1)
MOVE T1,LIBUF
MOVEM T1,CLN ;SET UP CURRENT LINE
JRST OUTSN ;AND PRINT NUMBER
LTLER: RERROR LTL
POP P,ALTP ;RESTORE ALTP
SKIPA
ILCER: RERROR NNN
PUSHJ P,FINDB ;MOVE BACK TO RIGHT PLACE
↑ERCOR: PUSH P,ALTCNT ;SAVE COUNT
SETZM ALTCNT
MOVE ALTP,[POINT 7,LIBUF+1,13] ;SET BACK TO START
PUSHJ P,ALTCBS ;PRINT LINE NUMBER
POP P,T2 ;COUNT
JUMPN T2,ALTSP ;AND SPACE OVER
POPJ P, ;NO SPACES TO DO
BEND JOINA
BEGIN ALTBS
↑ALTBS: CAMN ALTP,[POINT 7,LIBUF+1,13] ;ARE WE AT START OF LINE
JRST ALTCBS ;YES, GIVE CR/LF AND SEQ NUMBER
IFE FULDPX,<MOVEI T1,[ASCIZ /\/]
CALLI T1,3 ;PRINT A \>
ONRUB
SUBI ALTP,1 ;BACKSPACE POINTER
REPEAT 3,<IBP ALTP>
ILDB C,ALTP
IFN FULDPX,<PUSHJ P,OCHR>
SOS ALTCNT ;DECREASE COUNT
SOJG T2,ALTBS ;MORE,MORE
IFN FULDPX,<OUTPUT TTY,0>
POPJ P,
↑ALTCBS:OFFRUB
TERPRI (T1)
MOVE T1,LIBUF ;ALSO PRINT SEQ NUM
JRST OUTSN
BEND ALTBS
ALTLN: MOVEI T2,1000 ;FINISH PRINTING THE LINE
PUSHJ P,ALTSP
MOVE ALTP,[POINT 7,LIBUF+1,13] ;POINTER TO START
SETZM ALTCNT ;RESET COUNT
JRST ALTCBS ;AND PRETEND A BACKSPACE
BEND ALTLIN
SUBTTL RENUMBER COMMAND
BEGIN NUMBER
;RENUMBER SELECTED LINES
↑NUMBER:MOVE T1,[ASCID /00100/] ;IF NO INCR IS SEEN
MOVEM T1,REINC ;WE WILL USE 100
MOVEM T1,INCST
SETZM LOLN ;GET THIS SET TO START THINGS OFF
PUSHJ P,SCAN ;GET THE RENUMBER INCREMENT
TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
NERROR ILC
TRNE FL,NUMF ;WAS IT A NUMBER
CAMN T1,[ASCID /00000/] ;NO 0 RENUMBER INCR
JRST NUMBC ;NO NUMBER, CHECK FOR COMMA
MOVEM T1,REINC ;THE INCREMENT TO USE
MOVEM T1,INCST ;LINE TO START WITH
PUSHJ P,SCAN ;SCAN PAST NUMBER
NUMBC: CAIN C,"," ;AND CHECK FOR COMMA
JRST NUMB1 ;GET A RANGE
MOVEI T1,1 ;NO RANGE, DO WHOLE FILE
MOVEM T1,LOPG ;FROM PAGE 1
MOVSI T1,1 ;TO IMPOSSIBLY HIGH
MOVEM T1,HIPG
TRZ FL,CNTF ;MAKE SURE THIS IS OFF
JRST NUMBL ;AND CHECK FOR TERMINATOR
NUMB1: PUSHJ P,GET2S ;GET A RANGE
CAIE C,"," ;SEE IF THERE IS A FOURTH ARGUMENT
JRST NUMBL ;NO
PUSHJ P,SCAN ;YES, GET IT
TRNN FL,NUMF ;IS IT A NUMBER?
NERROR ILC ;HE WOULD HAVE BEEN BETTER OFF WITHOUT IT
MOVEM T1,INCST ;USS AS STARTING NUMBER
PUSHJ P,SCAN ;SCAN PAST IT
NUMBL: TRNN FL,TERMF ;ENDS PROPERLY?
NERROR ILC ;LOSE
MOVE T1,LOPG ;GET PLACE TO START
MOVEM T1,DPG
MOVE SINDEX,LOLN ;AND LINE
PUSHJ P,FIND ;GET IT
TRZ FL,LINSN!ORDF ;SET TO NONE SEEN AND NO ORDER ERROR
PUSHJ P,FINDB ;BACK UP AND SEE HOW ORDER LOOKS
JUMPE T1,NUMB5 ;START OF FILE IT MUST BE OK
CAME T1,PGMK ;ALSO IF A PAGE MARK
CAMGE T1,INCST ;OR IF IN CORRECT ORDER
SKIPA
TRO FL,ORDF ;WRONG SET FLAG
NUMB5: PUSHJ P,FIND ;GET THE CORRECT LINE BACK
NUMB2: PUSHJ P,ONMOV ;CHECK RANGE
JRST NUMB3
CAMN T1,PGMK ;PAGE MARK?
JRST NUMB4 ;SPECIAL TREATMENT
MOVE T1,INCST ;GET STAATING NUMBER
MOVE T2,REINC ;AND INCREMENT
TRON FL,LINSN ;WAS A LINE SEEN?
JRST FSTLIN ;NO, FIRST ONE IS SPECIAL
PUSHJ P,ASCIAD ;SKIP THIS THE FFRST TIME
CAMGE T1,REINC ;HAVE WE WRAPED
JRST [RERROR WAR ;TELL HIM HE LOST
MOVE T2,CPG ;PRINT THE PAGE
PUSHJ P,PGPRN
JRST .+1] ;RETURN
FSTLIN: MOVEM T1,INCST ;SAVE FOR NEXT LINE
MOVEM T1,CLN ;AND THE CURRENT LINE
MOVEM T1,(PNTR) ;PUT IT IN
PUSHJ P,FINDN ;GET NEXT
JRST NUMB2 ;AND GO RANGE CHECK
NUMB3: TRNN FL,LINSN ;DONE, WAS THERE SOMETHING THERE?
NERROR NLN ;NO, NULL RANGE ERROR
MOVE T2,CPG ;SET UP CURRENT PAGE
MOVEM T2,CPGL
TRNE FL,ORDF ;WAS THERE AN ORDER ERROR?
NERROR ORDER ;YES, FLAG IT
JUMPE T1,COMND ;CHECK TO SEE IF LOSAGE NOW
CAME T1,PGMK
CAMLE T1,INCST
JRST COMND
NERROR ORDER
NUMB4: ;PAGE MARK
AOS CPG ;NOW ON A HIGHER PAGE
MOVE T1,[ASCID /00000/]
MOVEM T1,CLN ;SET TO FIRST LINE ON PAGE
TRO FL,LINSN ;WE SAW ONE
SETZM INCST ;START OVER ON NUMBERS
PUSHJ P,FINDN ;NOW GET NEXT LINE
JRST NUMB2
BEND NUMBER
SUBTTL NEXT, LAST LINE ROUTINES
BEGIN NXTLIN
↑NXTLIN:MOVE T1,CPGL ;REALLY FIND THE CURRENT LINE
MOVEM T1,DPG
MOVE SINDEX,CLN
PUSHJ P,FIND
CAMN T1,CLN ;DID WE REALLY FIND IT
PUSHJ P,FINDN ;YES, GET NEXT ELSE WE ALREADY HAVE IT
JUMPE T1,[NERROR NLN] ;EOF AND NOT FOUND
NXTL1: CAMN T1,PGMK ;IS THIS A PAGE MARK?
JRST NXTPG ;TREAT SPECIALLY
MOVEM T1,CLN ;SET AS CURRENT
MOVE T1,PNTR ;GET THE CURRENT POINTE
PUSHJ P,OUTLIN ;AND PRINT
JRST COMND ;DONE
NXTPG: AOS T2,CPG ;WE ARE ON THE NEXT PAGE
MOVEM T2,CPGL
PUSHJ P,PGPRN ;TELL HIM
PUSHJ P,FINDN ;FIND A LINE ON IT
JUMPN T1,NXTL1 ;THERE IS ONE THERE, PRINT IT
MOVE T1,[ASCIZ /00000/] ;END OF FILE, SET TO THAT PAGE
MOVEM T1,CLN
JRST COMND
BEND NXTLIN
BEGIN BAKLIN
↑BAKLIN:MOVE T1,CPGL ;FIND CURRENT
MOVEM T1,DPG
MOVE SINDEX,CLN
PUSHJ P,FIND
TRNE FL,BOF ;IF NOT AT START OF FILE
CAME PNTR,BUFP ;OR NOT AT START OF BUFFER
SKIPA
NERROR NLN
BAK1: PUSHJ P,FINDB
CAMN T1,PGMK
JRST PRVPAG ;TELL HIM WE CROSSED A PAGE BOUNDARY
MOVEM T1,CLN ;SET AS CURRENT
MOVE T1,PNTR
PUSHJ P,OUTLIN
JRST COMND
PRVPAG: MOVE T2,CPG
MOVEM T2,CPGL
PUSHJ P,PGPRN
TRNE FL,BOF ;CHECK FOR START OF WORLD
CAME PNTR,BUFP
JRST BAK1 ;OK, BACK UP SOME MOR
MOVE T1,[ASCID /00000/]
MOVEM T1,CLN
JRST COMND
BEND BAKLIN
SUBTTL ROUTINE TO SEARCH FOR SOME STRINGS
BEGIN SEARCH
;DO A SEARCH OF A FILE
↑SEARCH:TLZ FL,ASSMF ;CLEAR ALL FLAGS
SETZM LOLN ;JUST LIKE EVERYONE ELSE HAS TO
SETZM SRCNT ;START WITH ZERO
MOVE T1,[POINT 7,SRBUF] ;SET UP BYTE POINTER
MOVEI T3,SRPNT ;AND POINTER TO BYTE POINTER TABLE
PUSHJ P,SSTRNG ;GET A SEARCH STRING
JRST [SKIPN SRPNT ;WAS STRING SET?
NERROR NSG ;NO, TELL HIM
CAIN C,12
JRST ASSMD1 ;SPECIAL CONTINUE MODE
JRST .+1] ;YES, USE OLD ONE
TLZ FL,NUMSRF!ALTSRF!EXCTSR ;CLEAR FLAGS
TRZ FL2,ZSRF!ZSPA ;CLEAR Z MODE EDIT BITS
PUSHJ P,SCAN ;CHECK FOR WHAT COMES AFTER
TRNN FL,TERMF ;IF TERMINATOR
CAIN C,"," ;OR ,
JRST ASSMDT ;SET UP LIMITS SPECIALLY
CAIE C,"!"
CAIN C,":"
JRST ASSMDT ;LET HIM SPECIFY 2ND HALF OF RANGE
PUSHJ P,GET2 ;ELSE CALL USUAL LIMIT ROUTINE
SRC4: MOVE T1,HILN ;SAVE END OF RANGE
MOVEM T1,SRHILN
MOVE T1,HIPG
MOVEM T1,SRHIPG
CAIE C,"," ;ANY MORE ARGUMENTS?
JRST SRC1 ;NO, CHECK TERMINATOR AND PROCEED
PUSHJ P,SCAN ;YES, SEE WHAT IT IS
TRNN FL,IDF ;SHOULD BE IDENT OR NUMBER
JRST SRC2 ;NOT IDENT, CHECK FOR NUMBER OF SEARCHES
MOVS T1,ACCUM ;GET THE IDENT
CAIN T1,'N ' ;AND FIND OUT WHAT IT IS
TLO FL,NUMSRF
CAIN T1,'Z ';WANT TO EDIT FOUND THING IN Z MODE?
JRST [TRNN FL,DPYF ;YES, CAN WE?
NERROR ILC ; NOT REALLY
TRO FL2,ZSRF ;YES, SET Z MODE BIT
JRST STSRF]
CAIN T1,'A '
STSRF: TLO FL,ALTSRF ;FIRST CHECK FOR A OR N
TRNE FL,READOF ;IF READ ONLY AND ALTER
TLNN FL,ALTSRF
SKIPA
NERROR ILC ;WE DO NOT PERMIT IT
TLNN FL,NUMSRF!ALTSRF ;WAS IT EITHER?
JRST SRC3 ;NO, CHECK E
PUSHJ P,SCAN ;CONTINUE LOOKING
CAIE C,","
JRST SRC1 ;NO MORE ARGUMENTS
PUSHJ P,SCAN ;WELL WHAT KIND IS THIS ONE?
TRNN FL,IDF ;MORE IDENTS?
JRST SRC2 ;NO, MUST BE NUMBER OF SEARCHES
MOVS T1,ACCUM
SRC3: CAIE T1,'E '
NERROR ILC ;NO, HE MUST HAVE MADE A MISTAKE
TLO FL,EXCTSR ;YES, REMEMBER IT
PUSHJ P,SCAN ;AND CHECK FOR MORE
CAIE C,","
JRST SRC1 ;NO MORE
PUSHJ P,SCAN ;ONLY ONE THING IT CAN BE NOW
SRC2: TRNN FL,NUMF
NERROR ILC ;NOPE, LOSE
MOVEM T2,SRCNT ;SAVE AS COUNT OF LINES TO FIND
PUSHJ P,SCAN ;GET TERMINATOR (WE HOPE)
SRC1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
NERROR ILC ;BUT THIS DOSNT
SRCH1A: MOVEI T1,SRPNT ;GET POINTER TO STRINGS
PUSHJ P,CODSR ;AND GENERATE CODE
MOVE T1,LOPG ;GET SET TO HUNT IT
MOVEM T1,DPG
MOVEM T1,SRPG ;FLAG TO SAY IF WE SHOULD PRINT PAGE
MOVE SINDEX,LOLN
PUSHJ P,FIND
TRZ FL,LINSN ;NO LINES YET
ONSRC: PUSHJ P,ONMOV ;CHECK RANGE
JRST ENDSRC ;DONE
TLZE FL,ASSMF ;FIRST TIME AND WANT .+1?
JRST [CAME T1,LOLN ;IS THERE EXACT MATCH?
JRST .+1 ;NO, THIS IS .+1
AOS SVCNT ;PRETEND WE DIDNT SEE IT
JRST SRNXT] ;AND TAKE NEXT
TRO FL,LINSN ;WE SAW ONE
CAMN T1,PGMK ;PAGES ARE SPECIAL
JRST SRCPAG ;SO TAKE GOOD CARE OF THEM
MOVEI T2,SRPNT ;POINTER TO STRINGS
PUSHJ P,COMSRC ;GO SEARCH THIS LINE
JRST SRNXT ;LOSER
WINNER: MOVEM T3,SVCCNT ;SAVE AWAY THE CHARACTER COUNT
MOVE T2,CPG ;GET CURRENT PAGE
CAME T2,SRPG ;AND SEE IF WE SHOULD PRINT IT
PUSHJ P,PGPRN ;YES
MOVE T2,CPG ;NOW SET IT AS CURRENT
MOVEM T2,CPGL
MOVEM T2,SRPG ;ALSO RESET FLAG
MOVE T2,(PNTR) ;ALSO SET LINE
MOVEM T2,CLN
TLNE FL,ALTSRF ;ARE WE GOING TO EDIT?
JRST SRCALT ;YES, GO SET THINGS UP
TLNE FL,NUMSRF ;DO WE WANT ONLY LINE NUMBERS?
JRST SRCNUM ;YES
MOVE T1,PNTR ;GO PRINT LINE
PUSHJ P,OUTLIN
SRNXTC: SOSG SRCNT ;HAVE WE FOUND ENOUGH
JRST COMND ;YES, GIVE UP (WE HAVE SEEN AT LEAST ONE)
SRNXT:
PUSHJ P,FINDN ;GET NEXT LINE TO LOOK A
JRST ONSRC
SRCNUM: MOVE T1,(PNTR) ;PRINT SEQUENCE NUMBER
PUSHJ P,OUTSN
TERPRI (T1)
JRST SRNXTC ;AND GO
ENDSRC: TRZN FL,LINSN ;DID WE SEE ONE?
NERROR NLN ;NULL RANGE
JRST COMND
SRCPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
JRST SRNXT ;AND PROCEED
SRCALT: TRNE FL2,ZSRF ;IN Z MODE
JRST ZSCALT ; YES, DO IT THAT WAY
PUSHJ P,SETALT ;SET THINGS UP
SKIPLE T2,SVCCNT ;GET COUNT (DO NOT CALL IF ≤0
PUSHJ P,ALTSP ;SPACE OVER CORRECTLY
PUSHJ P,ALTN1 ;GO ALTER
JRST LEVINS ;HE SAID ALTMODE
SRCA1: PUSHJ P,INSED ;INSERT IT
PUSHJ P,FINDN
PUSHJ P,FILLB ;MAKE SURE WE HAVE NOT GOTTEN TOO BIG
MOVE T1,(PNTR) ;GET POINTER BACK
SOSG SRCNT
JRST COMND ;DONE
JRST ONSRC ;GO ON
ZSCALT: PUSHJ P,SETALT ;GET READY
MOVE T2,SVCCNT ;NUMBER TO SPACE OUT
TRO FL2,ZSPA ;SPACE IT ON OUT
PUSHJ P,ZLNN1 ;EDIT THE LINE IN Z MODE
JRST LEVINS ;ALTMODE
JRST SRCA1 ;CONTINUE OR TERMINATE SEARCH
ASSMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
ASSMDT: TRZ FL,CNTF ;JUST IN CASE
TLO FL,ASSMF ;WE ASSUME .+1
MOVE T1,CLN ;SET THINGS UP FOR . TO INFINITY
MOVEM T1,LOLN
MOVEM T1,HILN ;AS GOOD AS ANYTHING WITH THE PAGE WE WILL
MOVE T1,CPGL ;USE
MOVEM T1,LOPG
TRZE FL,CNTF ;KEEP END?
JRST NOSPC ;YES
CAIE C,":" ;IF A : OR !
CAIN C,"!"
JRST HALFSP ;GET THE SECOND HALF (.+1 TO GIVEN)
MOVSI T1,377777 ;GET A LARGE PAGE
MOVEM T1,HIPG
JRST SRC4 ;BACK INTO THINGS
HALFSP: MOVEM T1,HIPG ;SET TOP AS /.
PUSHJ P,GET2HF ;GET THE SECOND HALF
JRST SRC4 ;AND GO
NOSPC: MOVE T1,SRHIPG
MOVEM T1,HIPG ;PUT BACK END
MOVE T1,SRHILN
MOVEM T1,HILN
JRST SRCH1A
BEND SEARCH
SUBTTL SUBST (SUBSTITUTE THINGS)
BEGIN SUBST
;ALSO KNOWN AS SUBSTITUTE
↑SUBST: TLZ FL,ASSMF ;DO NOT ASSUME ANYTHING YET
TRNE FL,READOF
NERROR ILC
SETZM LOLN ;A GOOD THING
MOVSI T1,37777 ;SET COUNT LARGE
MOVEM T1,RPCNT
MOVE T1,[POINT 7,R1BUF]
MOVEI T3,R1PNT
PUSHJ P,SSTRNG ;THIS CODE IS JUST LIKE SEARCH
JRST [SKIPE R2PNT ;BOTH STRINGS MUST HAVE BEEN GIVEN
SKIPN R1PNT
NERROR NSG ;ELSE THERE HAS BEEN AN ERROR
CAIN C,12 ;CHECK FOR JUST A CRRET
JRST ASSMD1 ;AND DO A CONTINUE
JRST NOSTR] ;THERE IS NO STRING
MOVE T1,[POINT 7,R2BUF] ;GET STRING TO REPLACE BY
MOVEI T3,R2PNT
PUSHJ P,SSTRNG
JRST [CAIN C,12
JRST [PUSH P,[.] ;SET UP RETURN
JRST RETSTR] ;AND READ MORE (FISRT NULL)
MOVEM T1,R2PNT ;NULL STRING MEANS DELETE
MOVEI T2,0 ;SO SET A REAL NULL STRING
IDPB T2,T1
JRST .+1]
SUBI T3,R2PNT ;GENERATE NUMBER OF REPLACEMENT STRINGS
MOVEM T3,RSTRCT ;AND SAVE FOR LATER
NOSTR: TLZ FL,NOPRN!DECID!EXCTS1 ;CLEAR FLAGS
PUSHJ P,SCAN ;AND START LOOKING FOR MORE JUNK
TRNN FL,TERMF ;NOTHING
CAIN C,"," ;OR JUST A COMMA
JRST ASSMDT ;THEN SEARCH FROM HERE TO ETERNITY
CAIE C,"!" ;HE ONLY WANTS TO GIVE A STOPPING POINT
CAIN C,":"
JRST ASSMDT
PUSHJ P,GET2 ;GO GET A RANGE
REP4: MOVE T1,HILN ;SAVE FOR POSSIBLE CONTINUE
MOVEM T1,RPHILN
MOVE T1,HIPG
MOVEM T1,RPHIPG
CAIE C,"," ;IS THERE MORE?
JRST REP1 ;NO
PUSHJ P,SCAN ;SEE WHAT IT IS
TRNN FL,IDF ;POSSIBLY AN IDENT
JRST REP2 ;NO MAYBE A NUMBER OF TIMES
MOVS T1,ACCUM
CAIN T1,'N '
TLO FL,NOPRN ;SET FOR NO PRINTING
CAIN T1,'D '
TLO FL,DECID ;HE WANTS TO BE ABLE TO DECIDE
TLNN FL,DECID!NOPRN ;IF NEITHER
JRST REP3 ;THEN TRY FOR E SWITCH
PUSHJ P,SCAN ;SEE IF THERE IS MORE
CAIE C,","
JRST REP1 ;END OF LINE
PUSHJ P,SCAN ;LOOK FOR STILL MORE
TRNN FL,IDF
JRST REP2
MOVS T1,ACCUM
REP3: CAIE T1,'E ' ;IS IT THE EXACT SEARCH SWITCH
NERROR ILC ;NO, LOSAGE
TLO FL,EXCTS1
PUSHJ P,SCAN ;ONE LAST TRY
CAIE C,","
JRST REP1 ;GO CHECK TERMINATOR
PUSHJ P,SCAN ;ONLY ONE THING LEFT
REP2: TRNN FL,NUMF
NERROR ILC ;BUT IT WAS NOT
MOVEM T2,RPCNT ;SAVE IT AWAY
PUSHJ P,SCAN
REP1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
NERROR ILC ;BUT NOT THIS ONE
REP1A: MOVEI T1,R1PNT ;GET THE SEARCH CODE
PUSHJ P,CODSR
MOVE T1,LOPG
MOVEM T1,DPG
MOVEM T1,RPPG ;FOR PRINT OUTS
MOVE SINDEX,LOLN
PUSHJ P,FIND ;GET THAT LIN¬
TRZ FL,LINSN ;NOTHING YET
ONREP: PUSHJ P,ONMOV ;CHECK FOR STILL IN RANGE
JRST ENDREP ;FINALLY
TLZE FL,ASSMF ;SHOULD WE START WITH .+1
JRST [CAME T1,LOLN ;IS IT THE ONE WE ASKED FOR
JRST .+1 ;NO, USE IT
AOS SVCNT ;JUST IN CASE A ! TYPE OF RANGE
JRST RPNXT]
TRO FL,LINSN ;THIS LINE IS GOOD ENOUGH
CAMN T1,PGMK
JRST RPPAG ;GO TAKE CARE OF PAGE MARKS
MOVEI T2,R1PNT ;DO THE SEARCH
PUSHJ P,COMSRC
JRST RPNXT
SKIPGE T3 ;PROTECT AGAINS ¬∀ KILLING TAB
IBP ALTP
PUSH P,T3 ;SAVE COUNT OF HOW FAR INTO LINE
MOVE T3,(PNTR) ;SET UP CURRENT LINE
MOVEM T3,CLN
MOVE T3,CPG
MOVEM T3,CPGL
MOVE T2,[XWD LIBUF,LIBUF+1] ;CLEAR IT OUT
SETZM LIBUF
BLT T2,LIBUF+MXWPL+1 ;WE WILL DO REPLACE HERE
MOVE T2,PNTR ;GET THE POINTER TO THE LINE
MOVE T3,(T2) ;PICK UP THE FIRST WORD
MOVEI T4,LIBUF ;THE PLACE TO PUT IT
JRST SALT3 ;TRANSFER
SALT2: SKIPE T3,(T2)
TRNE T3,1 ;IS IT THE END OF THE LINE
JRST SALT1
SALT3: MOVEM T3,(T4) ;PUT IT AWAY
ADDI T4,1
AOJA T2,SALT2
SALT1: SUBI T4,LIBUF ;GET SIZE LINE USED TO BE
MOVEM T4,OCNT
POP P,CCNT ;GET THE NUMBER OF CHRS INTO LINE
SKIPGE CCNT ;MUST BE ≥0
SETZM CCNT
SUBI ALTP,(PNTR) ;CONVERT POINTER TO LIBUF
ADD ALTP,[XWD 70000,LIBUF] ;AND BACK UP ONE
NXTRPL: LDB T1,[POINT 4,-1(T1),12] ;GET STRING NUMBER
CAMLE T1,RSTRCT ;IS IT LARGER
MOVE T1,RSTRCT ;THEN USE LAST
MOVE T1,R2PNT(T1)
MOVSI T4,70000 ;DECREMENT POINTER
ADDM T4,SRCALP
REPSTR: ILDB C,T1 ;GET THE NEXT CHR
JUMPE C,ENDRP ;THE END OF THE REPLACE STRING
CAIN C,"∂" ;DOES HE WANT ONE OF THE PARTIAL THINGS
JRST PARSTR ;YES, GO HANDLE THAT
CAIN C,"≡" ;CHECK FOR QUOTING NEXT CHR
JRST INSQT
PUTSTR: IDPB C,ALTP ;PUT IN THE REPLACEMENT
AOS C,CCNT ;ADVANCE COUNT
CAIL C,MXWPL*5 ;CHECK AGAINST MAX
NERROR LTL ;AND LOSE
JRST REPSTR
ENDRP: MOVE T3,CCNT ;GET COUNT SO SEARCH CAN GO ON
PUSH P,ALTP ;SAVE REPLACE POINTER
PUSH P,SRCALP ;AND THE END OF INPUT POINTER
MOVE ALTP,SRCALP ;CONTINUE FROM HERE
ILDB T1,SRCALP ;SEE WHAT CHAR WE STOPPED ON
CAIE T1,12 ;HAVE WE GONE TOO FAR?
PUSHJ P,COMSRT ;THIS WILL CONTINUE
JRST FINLIN ;ALL DONE WITH MATCHES, FINISH UP
CAIL T3,MXWPL*5 ;ARE THERE TOO MANY?
NERROR LTL
POP P,T2
DOMOV: ILDB C,T2 ;MOVE THE CHRS THAT DID NOT MATCH
CAMN T2,ALTP ;HAVE WE GOTTEN TO THE NEXT MATCH
JRST DONMOV ;YES
IDPB C,(P) ;THE BYTE POINTER IS STILL IN THE STACK
JRST DOMOV
DONMOV: MOVEM T3,CCNT ;PUT THE COUNT BACK IN CORE
POP P,ALTP ;THIS IS NOW THE DEPOSIT POINTER
JRST NXTRPL ;GO DO A REPLACE
FINLIN: POP P,SRCALP ;GET SET TO MOVE TO END
POP P,ALTP
ILDB C,2(P) ;WE JUST HAPPEN TO KNOW ITS STILL THERE
CAIE C,12 ;IF SO WE HAVE EATEN A RETURN
JRST ENDFIN ;ALL IS OK
FINL2: MOVEI C,15
SKIPA ;SO PUT IT IN
ENDFIN: ILDB C,SRCALP
IDPB C,ALTP
AOS CS,CCNT
CAIL CS,MXWPL*5
NERROR LTL
CAIE C,12
JRST ENDFIN ;DONE WHEN WE SEE THE LINE FEED
MOVEI T1,0 ;ZERO OUT REST OF THIS LINE
DOZER: TLNN ALTP,760000 ;POINTER AT END OF LINE?
JRST ZEROD
IDPB T1,ALTP
JRST DOZER
ZEROD: MOVEI ALTP,1-LIBUF(ALTP) ;GET COUNT
MOVEM ALTP,NCNT
TLNE FL,NOPRN ;DID HE WANT PRINTING SUPRESSED
JRST NOPLIN
MOVE T2,CPG ;GET THIS PAGE
CAMN T2,RPPG ;IS IT ONE WE STARTED ON
JRST NOPPRN ;YES, DO NOT PRINT 'PAGE '
MOVEM T2,RPPG ;SAVE FOR NEXT TIME
PUSHJ P,PGPRN
NOPPRN: MOVEI T1,LIBUF ;PRINT THE LINE
PUSHJ P,OUTLIN
TLNN FL,DECID ;DOES HE WANT THE OPTION OF SAYING NO
JRST NOPLIN ;NO, INSERT IT
IFE FULDPX,<MOVEI T1,DDTINB ;READ
CALLI T1,1
LDB T1,[POINT 7,DDTINB,6] ;GET FIRST CHR
MOVEI T2,[ASCIZ /
/] ;GIVE HIM A RETURN
CALLI T2,3>
IFN FULDPX,<TTYUUO 0,T1
ANDI T1,177
TTYUUO 3,[ASCIZ /
/]>
CAIN T1,177 ;DID HE SAY RUBOUT(DO NOT INSERT)?
JRST RPNXT1 ;YES, JUST IGNORE THIS LINE
CAIE T1,"e" ;EITHER CASE
CAIN T1,"E" ;DOES HE WANT OUT
JRST ENDREP ;YES, QUIT
NOPLIN: PUSHJ P,INSED ;ANYTHING ELSE IS OK
PUSHJ P,FINDN ;GET NEXT
PUSHJ P,FILLB ;IN CASE IT GOT LONGER
SOSG RPCNT ;SEE IF OUT OF COUNT
JRST COMND
MOVE T1,(PNTR) ;GET POINTER BACK
JRST ONREP
ASSMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
ASSMDT: TRZ FL,CNTF ;JUST IN CASE
TLO FL,ASSMF ;WE ASSUME .+1
MOVE T1,CLN
MOVEM T1,LOLN ;SET FOR HERE TO ETERNITY
MOVEM T1,HILN
MOVE T1,CPGL
MOVEM T1,LOPG
TRZE FL,CNTF ;KEEP END?
JRST NOSPC
CAIE C,":" ;IF A : OR A !
CAIN C,"!"
JRST HALFSP ;GET THE SECOND HALF (.+1 TO GIVEN)
MOVSI T1,377777 ;GET A LARGE PAGE
MOVEM T1,HIPG
JRST REP4 ;ONWARD
HALFSP: MOVEM T1,HIPG ;SET TO AS /.
PUSHJ P,GET2HF ;GET THE SECOND HALF
JRST REP4 ;AND GO
NOSPC: MOVE T1,RPHIPG
MOVEM T1,HIPG
MOVE T1,RPHILN
MOVEM T1,HILN
JRST REP1A
INSQT: ILDB C,T1 ;GET NEXT CHR
JUMPN C,PUTSTR ;MUST NOT BE 0
NERROR IRS ;THIS STRING IS ILLEGAL
PARSTR: MOVEI CS,0 ;FIND OUT THE NUMBER
PARST1: ILDB C,T1 ;GET A CHR
CAIN C,"∂" ;CHECK FOR END
JRST ENDNUM
CAIL C,"0" ;MUST BE A DIGIT
CAILE C,"9"
NERROR IRS
IMULI CS,=10 ;CONVERT
ADDI CS,-"0"(C)
JRST PARST1
ENDNUM: CAILE CS,0
CAMLE CS,ARBCNT ;IS IT IN RANGE
NERROR IRS ;NO SUCH PARTIAL STRING
MOVE T4,[POINT 7,ARBBUF] ;START LOOKING FOR IT
SOJLE CS,FNDRST ;STARTS WITH STRING 1
NXTST: ILDB C,T4
JUMPN C,NXTST ;0 IS END OF A PARTIAL STRING
SOJG CS,NXTST ;LOOK FOR CORRECT STRING
FNDRST: ILDB C,T4 ;NOW INSERT THAT STRING
JUMPE C,REPSTR ;GO FINISH THE REPLACEMENT STRING
IDPB C,ALTP
AOS C,CCNT
CAIL C,MXWPL*5
NERROR LTL
JRST FNDRST
RPNXT1: SOSG RPCNT
JRST COMND
RPNXT:
PUSHJ P,FINDN
JRST ONREP ;CONTINUE LOOKING AT LINES
ENDREP: TRZN FL,LINSN ;WERE THERE ANY?
NERROR NLN
JRST COMND
RPPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
JRST RPNXT
BEND SUBST
SUBTTL PAGE MARK ROUTINE
BEGIN MARK
;INSERT A PAGE MARK AT DESIGNATED LINE
↑MARK: SETZM HILN ;IN CASE OF /A
TRNE FL,READOF ;NOT PERMITTED IN READ ONLY
NERROR ILC
PUSHJ P,GET1S ;GET ONE LINE/PAGE NUMBER
TRNN FL,TERMF ;CHECK FOR TERMINATOR
NERROR ILC
MOVE T1,HIPG ;GO LOOK FOR IT
MOVEM T1,DPG
MOVE SINDEX,HILN ;AND THE LINE
PUSHJ P,FIND ;GET IT
MOVE T1,CPG
CAME T1,HIPG ;PAGE MUST MATCH
NERROR NSP ;MUST MATCH
AOS T1,CPG ;WILL BE ON HIGHER PAGE WHEN DONE
MOVEM T1,CPGL ;SET UP LOGICAL PAGE
AOS BGPG ;THERE IS NOW ONE MORE
AOS INPG
MOVE T1,[ASCID /00000/]
MOVEM T1,CLN ;FIRST LINE ON THAA PAGE
MOVE T1,PGMK ;PUT A PAGE MARK IN LIBUF
MOVEM T1,LIBUF
MOVE T1,[BYTE (7) 15,15,14] ;TEXT OF A PAGE MARK
MOVEM T1,LIBUF+1
SETZM OCNT ;THIS IS A STRAIGHT INSEET
MOVEI T1,2 ;OF 2 WORDS
MOVEM T1,NCNT
PUSHJ P,INSED ;GO DO IT
PUSHJ P,FINDN ;SINCE FILLB MAY WANT TO DUMP THIS LINE
PUSHJ P,FILLB
JRST COMND ;ALL DONE
BEND MARK
SUBTTL DATA COPY AND TRANSFER ROUTINES
BEGIN COPY
↑TRANS: TLOA FL,TRANFL ;SET AS TRANSFER COMMAND
↑COPY: TLZ FL,TRANFL ;JUST TO MAKE SURE
SETZM HILN ;THIS, TOO MAY PROVE USEFUL
SETZM LOLN ;A GOOD THING TO DO
TRNE FL,READOF ;DO NOT LET HIM IN READ ONLY MODE
NERROR ILC
SETZM SVJRL2 ;NO SECOND JOBREL SAVED
PUSHJ P,GET1S ;GET PLACE TO PUT LINES
MOVE T1,HIPG ;STORE IT AWAY FOR LATER
MOVEM T1,DESTPG
MOVE T1,HILN
MOVEM T1,DESTLN
CAIN C,"←" ;DOES HE WANT TO COME FROM ANOTHER FILE?
JRST ALTFIL ;YES
TLZ FL,COPFIL ;NO, MAKE SURE FLAG IS OFF
COPY1:
CAIE C,"," ;SHOULD BE COMMA EVEN IF FROM ALTFIL
NERROR ILC ;HE MUST SAY WHERE TO PUT IT
COPY1A: PUSHJ P,GET2S ;GO GET PLACE TO FIND LINES
MOVE T1,INCR ;SEV INCREMENT AS CURRENT
MOVEM T1,FINCR
SETZM SINCR ;SET NO SECOND INCREMENT
CAIE C,"," ;CHECK FOR MORE ARGUMENTS
JRST CKTERM ;NO, LOOK FOR TERMINATOR
PUSHJ P,SCAN
CAME T1,[ASCID /00000/] ;AVOID 0 INCREMENTS
TRNN FL,NUMF ;SHOULD BE INCREMENT, MUST BE NUMBER
NERROR ILC
MOVEM T1,FINCR
PUSHJ P,SCAN
CAIE C,","
JRST CKTERM
PUSHJ P,SCAN
CAME T1,[ASCID /00000/]
TRNN FL,NUMF
NERROR ILC
MOVEM T1,SINCR
PUSHJ P,SCAN
CKTERM: TRNN FL,TERMF
NERROR ILC ;DID NOT END PROPERLY, LOSE
SETOM NLIN1 ;LINES ON FIRST PAGE
SETZM NLIN2 ;LINES ON LAST PAGE
TLO FL,ISCOP ;SO WE WILL DO SPECIAL RESET IF ERROR
MOVE ALTP,JOBREL ;SET UP SAVE POINTER
MOVEM ALTP,SVJRL ;SO WE CAN RESET IT
MOVEI T1,2000(ALTP) ;ASK FOR ANOTHER 1K
CALLI T1,11
NERROR NEC ;ALL OUT, GIVE UP
HRLI ALTP,-2000 ;SET COUNT OF HOW MUCH IS THERE
SETZM LSTPG ;HAVE SEEN NO PAGES YET
MOVE T1,LOPG ;LOOK FOR SOURCE
MOVEM T1,DPG
MOVE SINDEX,LOLN
PUSHJ P,FIND
TRZ FL,LINSN ;AND NO LINES
TLNN FL,TRANFL ;IS THIS A TRANSFER COMMAND?
JRST GOCOP ;NO, IGNORE ALL THIS SPECIAL STUFF
HRRZM ALTP,STARTD ;SAVE THE START OF DELETED CODE
HRRZM ALTP,ENDD ;AND THE END
MOVE T1,CPG ;GET THE PAGE ON WHICH DELETION STARTS
MOVEM T1,TRANST ;AND SAVE IT
SKIPN -1(PNTR) ;ARE WE AT THE START OF THE BUFFER
TRNN FL,BOF ;AND OF THE WORLD
SKIPA
JRST BEGFIL ;YES, DO NOT LOOK BACK
PUSHJ P,FINDB ;GET THE PREVIOUS LINE
CAMN T1,PGMK ;A PAGE IS SPECIAL
JRST SPCPG
MOVEM T1,BOTLIN ;SAVE IT FOR LATER
PUSHJ P,FINDN ;GO FORWARD AGAIN
JRST GOCOP
SPCPG: SKIPE LOLN ;DO WE INTEND TO ABSORD THIS ONE
JRST BEGFIS ;MOVE FORWARD AND RECORD
SKIPN -1(PNTR) ;CHECK FOR START OF WORLD AGAIN
TRNN FL,BOF
SKIPA
JRST BEGFIS
PUSHJ P,FINDB ;BACK UP
AOS CPG ;FIX PAGE COUNT
PUSH P,T1 ;SAVE THAT LINE
PUSHJ P,FINDN
PUSHJ P,FINDN ;AND GO BACK WHERE WE BELONG
POP P,T1 ;GET LINE NUMBER BACK
CAMN T1,PGMK ;THERE'S THAT PAGE AGAIN
JRST BEGFIA
MOVEM T1,BOTLIN ;SAVE LINE NUMBER
JRST GOCOP
BEGFIS: AOSA CPG
BEGFIA: AOSA CPG
BEGFIF: PUSHJ P,FINDN
BEGFIL: SETOM BOTLIN ;A VERY SMALL NUMBER
GOCOP: SETZM PGDELS ;TOTAL NUMBER OF PAGES DELETED IS 0
SKIPE LOLN ;DID HE ASK FOR THE WHOLE PAGE
JRST NOISTP ;NO
MOVE T1,PGMK ;YES, PUT IN THE PAGE MARK
MOVEM T1,1(ALTP)
MOVE T1,[BYTE (7) 15,15,14]
MOVEM T1,2(ALTP)
HRRZM ALTP,LSTPG
ADD ALTP,[XWD 2,2]
SETZM NLIN1 ;NO LINES ON FIRST PAGE
TLNN FL,TRANFL ;IS THIS A TRANSFER
JRST NOISTP ;NO, START TRANSFER OF DATA
MOVE T1,CPG ;CHECK TO SEE IF WE SHOULD REALLY DELETE
CAIN T1,1 ;NOT IF PAGE 1
JRST RSTSTP
PUSHJ P,FINDB ;GET THAT PAGE
SETZM NCNT ;DELETE
MOVEI T1,2
MOVEM T1,OCNT
PUSHJ P,INSED
PUSHJ P,FINDN1 ;MAKE SURE WE ARE AT THE LINE WE WERE AT
AOS CPG ;KEEP COUNT STRAIGHT
AOSA PGDELS ;ONE DELETED
RSTSTP: HRRZM ALTP,STARTD ;RESET START IF NONE DELETED
HRRZM ALTP,ENDD ;RESET END
NOISTP: MOVE T1,(PNTR) ;MAKE SURE WE HAVE THAT JUNK BACK
ONCOPY: PUSHJ P,ONMOV ;STILL IN RANGE?
JRST ENDCOP ;NO, START INSERTING
TRO FL,LINSN ;WE SAW ONE
CAMN T1,PGMK ;IS IT A PAGE?
JRST MOVPG ;YES, TREAT SPECIAL
MOVLIN: MOVE T1,PNTR ;START TRANSFER
MOVE T2,(T1) ;PICK UP FIRST WORD (SEQ NUM)
MOVEM T2,LSTLN ;SAVE FOR INC CALC
TRLIN: MOVEM T2,1(ALTP) ;PUT LINE AWAY
AOBJP ALTP,RESTCR ;NEED MORE CORE?
TRLIN1: SKIPN T2,1(T1) ;END OF LING?
JRST NXTLIN
TRNN T2,1
AOJA T1,TRLIN ;NO MOVE NEXT WORD
NXTLIN: TLNN FL,TRANFL ;IS THIS TRANSFER?
JRST NXTLCP ;NO, DON'T DELETE
HRRZM ALTP,ENDD ;SAVE END OF DELETED TEXT
SETZM NCNT
SUBI T1,-1(PNTR) ;GET LENGTH
MOVEM T1,OCNT
PUSHJ P,INSED
PUSHJ P,FINDN1 ;MAKE SURE A LINE IS THERE
SKIPA ;SKIP THE FINDN
NXTLCP: PUSHJ P,FINDN ;YES, GET NEXT
AOS NLIN2 ;ONE MORE LINE
JRST ONCOPY
MOVPG: AOS CPG ;WE ARE ON NEXT PAGE
MOVE T1,NLIN2
SKIPGE NLIN1 ;PUT ON FIRST PAGE IF NOT SOME ALREADY THERE
MOVEM T1,NLIN1
SETZM NLIN2
HRRZM ALTP,LSTPG ;SAVE RECORD OF WHERE SEEN
AOS PGDELS ;RECORD ONE MORE PAGE DELETED
JRST MOVLIN ;NOW MOVE IT
RESTCR: MOVE T2,JOBREL ;GET END
ADDI T2,2000
CALLI T2,11 ;GET MORE
NERROR NEC
HRLI ALTP,-2000
JRST TRLIN1 ;AND CONTINUE
ENDCOP: TRNN FL,LINSN ;WERE THERE ANY THERE?
NERROR NLN ;NO LOSE
SETZM 1(ALTP) ;MAKE SURE THERG IS AN END FLAG THERE
TLZE FL,COPFIL ;ARE WE COMMING OFF A FILE
PUSHJ P,RSCOP ;YES, RESET POINTERS
MOVE T1,DESTPG ;LOOK FOR DESTINATION
MOVEM T1,DPG
TLNN FL,TRANFL ;IS IT A TRANSFER?
JRST DOINS1 ;NO, PUT THE COPIED TEXT IN
SETZM PGINSD ;NO EXTRA PAGE MARK INSERTED YET
SKIPN T2,(PNTR) ;ARE WE AT EOF
JRST NOPGIN ;YES, DO NOT INSERT A PAGE MARK
CAME T2,PGMK ;ALSO NOT IF PAGE MARK
CAMLE T2,BOTLIN ;OR GREATER THAN LINE LEFT OVER
SKIPA
SETOM PGINSD ;WE WILL HAVE TO INSERT ONE
NOPGIN: MOVN T2,PGDELS ;GET MINUS NUMBER OF PAGES DELETED
SUB T2,PGINSD ;ONE LESS IF A PAGE MARK INSERTED
CAMGE T1,TRANST ;(T1 HAS DEST. PAGE) IF SMALLER THAN START
JRST DOSUB ;EVERYTHING IS OK
CAMN T1,TRANST ;IS IT SAME?
JRST DSEQTR ;SPECIAL CHECK REQUIRED
CAMGE T1,CPG ;INSIDE RANGE DELETED?
NERROR ITD ;LOSE BIG
CAMN T1,CPG ;SAME AS TOP PAGE?
JRST DSEQCP
ADDM T2,DESTPG ;ADJUST PGE WE ARE TO FIND
ADDM T2,DPG
DOSUB: ADDM T2,CPG ;ADJUST FOR REMOVED PAGES
ADDM T2,INPG
ADDM T2,BGPG
SKIPN PGINSD ;SEE IF WE WANT TO INSERT ONE
JRST DOINS1
MOVE T1,PGMK
MOVEM T1,LIBUF
MOVE T1,[BYTE (7) 15,15,14]
MOVEM T1,LIBUF+1
SETZM OCNT
MOVEI T1,2
MOVEM T1,NCNT
PUSHJ P,INSED
PUSHJ P,FINDN ;ADVANCE OVER IT
PUSHJ P,FILLB ;IN CASE OF OVERFLOW
MSG (T1,<PAGE MARK INSERTED TO PREVENT ORDER ERROR>)
JRST DOINS1
ALLSAM: SKIPN LOLN
SKIPE PGINSD ;IF DID NOT DELETE PAGE OR INSERTED ONE
JRST DOSUB ;ALL OK
SKIPE T1,(PNTR) ;ELSE MUST BE IN UPPER PART
CAMN T1,PGMK
NERROR ITD ;THERE IS NO UPPER PART
CAMLE T1,DESTLN
NERROR ITD
SOS T1,DESTPG ;THIS WILL BE ON A LOWER PAGE
MOVEM T1,DPG
JRST DOSUB
DSEQTR: CAMN T1,CPG ;IS IT ALL ON SAME PAGE?
JRST ALLSAM ;YES, SPECIAL CHECKING
SKIPN LOLN ;DID WE START WITH A PAGE
NERROR ITD ;YES, LOSE
SKIPE PGINSD ;WAS THERE A PAGE INSERTED?
JRST DOSUB ;YES, ALL OK
SKIPE T1,(PNTR) ;FIND OUT WHAT THE NEXT LINE IS
CAMN T1,PGMK
JRST DOSUB ;THIS WILL BE OK
CAMG T1,DESTLN ;SEE IF WE ARE IN TROUBLE
NERROR ITD
JRST DOSUB ;OK
DSEQCP: SKIPE PGINSD ;WAS ONE INSERTED
JRST AOSTRA ;SET PAGE PROPERLY
MOVE T1,DESTLN
CAMG T1,BOTLIN
NERROR ITD
SKIPA T1,TRANST
AOSTRA: AOS T1,TRANST
MOVEM T1,DESTPG
MOVEM T1,DPG ;ALSO SET THIS
JRST DOSUB
DOINS1: MOVE SINDEX,DESTLN
PUSHJ P,FIND
MOVE T1,CPG
CAME T1,DESTPG ;PAGES MUST MATCH
JRST [TLNN FL,TRANFL
NERROR NSP
MOVE T1,PGMK
MOVEM T1,LIBUF
MOVE T1,[BYTE (7) 15,15,14]
MOVEM T1,LIBUF+1
SETZM OCNT
MOVEI T1,2
MOVEM T1,NCNT
PUSHJ P,INSED
PUSHJ P,FINDN
PUSHJ P,FILLB
AOS CPG
AOS INPG
AOS BGPG
MSG (T1,<TEXT INSERTED AT END OF FILE>)
MOVE T1,CPG
JRST .+1]
MOVEM T1,CPGL ;SET THIS AS CURRENT PAGE
MOVE T1,DESTLN ;GET THE PAGE NUMBER TO PUT OUT
MOVEM T1,CLN ;AND THIS AS CURRENT LINE
MOVEM T1,SVLNUM
MOVE ALTP,SVJRL ;POINT TO START OF LINES TO COPY
TLZ FL,TRANFL ;THIS FLAG NO LONGER NEEDED
SKIPE T3,(PNTR) ;GET NEXT LINE AFTER THE INSERT
CAMN T3,PGMK
JRST [MOVEI T1,=100000 ;USE HIGH NUMBER IF NONE THERE
JRST SETHI]
PUSHJ P,NUMCON ;CONVERT ASCID TO NUMBER
SETHI: MOVEM T1,HIGH1 ;SAVE FOR LATER
MOVE T3,DESTLN ;GET NUMBER OF FIRST LINE TO BE INSERTED
PUSHJ P,NUMCON
MOVEM T1,DESTN ;SAVE IT TOO
SKIPGE NLIN1 ;DID WE SEE ANY PAGE MARKS?
JRST ONSET ;NO, ONLY ONE INC TO WORRY ABOUT
SKIPE SINCR ;WAS A SECOND INCREMENT GIVEN?
JRST DOSINC ;YES
SKIPE T3,(PNTR)
CAMN T3,PGMK ;ARE THERE ANY LINES AFTER IT
JRST OKINC2 ;NO, OK TO LEAVE LINES AS THEY ARE
DOSINC: MOVE T1,HIGH1 ;CALCULATE MAX POSSIBLE INCREMENT
AOS T2,NLIN2 ;WICH WILL NOT RUIN ORDER
IDIV T1,T2
JUMPE T1,ORDSEC ;THERE IS NO POSSIBLE GOOD ONE
CAIL T1,=100000 ;A VERY LARGE ONE IS POSSIBLE
JRST OKINC2 ;SO JUST USE THE ONE GIVEN
PUSHJ P,ASCON ;CONVERT TO ASCID
SKIPN SINCR ;WAS THERE AN INC GIVEN?
JRST [MOVE T1,LSTLN ;GET THE HIGHEST LINE PICKED UP
CAML T1,(PNTR) ;SEE IF IT IS OK
JRST ONST3 ;NO
JRST OKINC2]
CAML T3,SINCR ;SEE IF ONE GIVEN IS OK
JRST OKINC2 ;YES
ONST3: MOVEM T3,SINCR ;NO, STORE CALCULATED
ONST2: MOVEM T3,PRNTO2 ;AND TELL HIM
IFE FULDPX,<MOVEI T1,ASCIZ2
CALLI T1,3>
IFN FULDPX,<TTYUUO 3,ASCIZ2>
OKINC2: MOVEI T1,=100000 ;FIND A SUITABLE FIRST INCREMENT
SUB T1,DESTN
SKIPN NLIN1 ;WERE THERE ANY?
JRST INSL2 ;NO, ALL IS OK
IDIV T1,NLIN1 ;GET USABLE ONE
JUMPE T1,ORDCP2 ;NONE POSSIBLE
CAIL T1,=100000
JRST INSL2 ;ALL OK
PUSHJ P,ASCON ;CONVER
CAML T3,FINCR ;IS ONE GIVEN SMALLER?
JRST INSL2 ;YES, ALL OK
MOVEM T3,FINCR
JRST ONST1 ;LET HIM KNOW
ONSET: SKIPG NLIN2 ;WERE THERE ANY?
JRST INSL2 ;ALL OK
MOVE T1,HIGH1
SUB T1,DESTN
IDIV T1,NLIN2 ;CALCULATE INCREMENT
JUMPE T1,ORDCOP ;NONE POSSIBLE
CAIL T1,=100000
JRST INSL2 ;VERY BIG, ALL OK
PUSHJ P,ASCON
CAML T3,FINCR ;IS ONE GIVEN SMALLER?
JRST INSL2
MOVEM T3,FINCR
ONST1: MOVEM T3,PRNTO1 ;PUT IN IN PRINT POSITION
IFE FULDPX,<MOVEI T1,ASCZ1
CALLI T1,3>
IFN FULDPX,<TTYUUO 3,ASCZ1>
JRST INSL2 ;HE HAS BEEN TOLD
ORDCP2: SKIPA T3,[ASCII /WAR /]
ORDCOP: MOVE T3,[ASCII /ORDER/]
JRST ONST1
ORDSEC: MOVE T3,[ASCII /ORDER/]
JRST ONST2
↑ASCON: MOVSI T3,400000 ;WILL BECOME LOW ORDER BIT
ASCO2: IDIVI T1,=10
ADDI T2,"0"
LSHC T2,-7
TRNN T3,1 ;HAS IT GOTTEN THERE?
JRST ASCO2
POPJ P,
NUMCON: MOVEI T1,0
TRZ T3,1 ;GET RID OF LOW ORDER BIT
NUMC1: MOVEI T2,0
LSHC T2,7
IMULI T1,=10
ADDI T1,-"0"(T2)
JUMPN T3,NUMC1
POPJ P,
INSLN: MOVE T2,FINCR ;GENERATE NEW SEQUENCE NUMBER
SKIPN T1,SVLNUM ;BUT ONLY IF WE ARE SUPPOSED TO
JRST INSL2
PUSHJ P,ASCIAD
MOVEM T1,SVLNUM ;PUT EITHER NGW OR 0 BACK
INSL2: SETZM LIBUF ;ZERO OUT PLACE TO PUT LINE
MOVE T1,[XWD LIBUF,LIBUF+1]
BLT T1,LIBUF+MXWPL+1
MOVEI T1,LIBUF ;SET UP OUTPUT POINTER
SKIPN T2,1(ALTP) ;AT END?
JRST INSDON ;FINISHED
INS1: MOVEM T2,(T1) ;PUT IT AWAY
ADDI ALTP,1 ;NEXT
SKIPN T2,1(ALTP) ;CHECK FOR END OF LING
JRST DOINS
TRNN T2,1 ;BY EITHER METHOD
AOJA T1,INS1 ;GO ON WITH TRANSFER
DOINS: SUBI T1,LIBUF-1 ;GET COUNT
MOVEM T1,NCNT ;AND SET AS NEW
SETZM OCNT ;OLD IS ZERO
MOVE T1,LIBUF ;GET SEQ NUM
CAMN T1,PGMK ;CHECK FOR PAGE
JRST INSPG ;AND DO SPECIAL
SKIPN T1,SVLNUM ;IF A NON-ZERO NUMBER THEN REPLACE
MOVE T1,LIBUF
MOVEM T1,LIBUF
NOINCR: MOVEM T1,CLN ;SET AS CURRENV LINE
PUSHJ P,INSED ;INSERT IT
PUSHJ P,FINDN ;GET NEXT
PUSHJ P,FILLB ;AND DUMP IF NEEDED
JRST INSLN ;GO PUT IN MORE
INSPG: AOS T3,CPG ;WE ARE ON THE NEXT PAGE
MOVEM T3,CPGL ;SET AS CURRENV
MOVE T1,[ASCID /00000/] ;SET TO SAY LINE 0
AOS BGPG ;ONE MORE PAGE IN FILE
AOS INPG
SETZM SVLNUM ;DO NOT DO ANY MORE SEQUENCE REPLACEMENT
MOVEI T2,-2(ALTP) ;SINCE WE HAVE ALREADY GONE PAST
CAMN T2,LSTPG ;UNLESS STARTING LAST PAGE
SKIPN T3,SINCR ;ANF SECOND SEQUENCE NUMBER GIVEN
JRST NOINCR
MOVEM T3,FINCR ;SET UP INCREMENT
MOVEI T3,1 ;AND RESTART NUMBERING
MOVEM T3,SVLNUM
JRST NOINCR
INSDON:
↑COPDON:RELEASE ALTDV,0 ;JUST FOR GOOD MEASURE
TLZE FL,COPFIL ;ARE WE COPYING FROM A FILE (ERRORS ONLY)
PUSHJ P,RSCOP ;YES, CLEAN UP POINTERS
TLZ FL,ISCOP ;RESET COPY FLAG
TLNN FL,TRANFL ;IF TRANSFER, WE MUST REINSERT
JRST COPD1 ;NO
MOVE ALTP,STARTD
REINXT: MOVEI T1,LIBUF
CAMN ALTP,ENDD
JRST COPD1 ;ALL DONE
MOVE T2,1(ALTP)
JRST REINWD
REINS: MOVE T2,1(ALTP)
CAME ALTP,ENDD
TRNE T2,1
JRST ENDLIN ;DONE WITH THIS LINE
REINWD: MOVEM T2,(T1)
ADDI T1,1
AOJA ALTP,REINS
ENDLIN: SETZM OCNT
SUBI T1,LIBUF
MOVEM T1,NCNT
PUSHJ P,INSED ;INSERT LINE
PUSHJ P,FINDN
PUSHJ P,FILLB ;IN CASE OF OVERFLOW
JRST REINXT
COPD1: SKIPN T1,SVJRL2 ;USE THIS IF SET
MOVE T1,SVJRL ;ELSE THIS
CALLI T1,11 ;TO RESTORE PROPER AMOUNT OF CORE
ERROR ICN ;THIS SHOULD NEVER HAPPEN
JRST COMND ;FINISH UP
ALTFIL: TLNE FL,TRANFL ;ANOTHER FILE IS NOT LEGAL IN TRANSFER
NERROR ILC
PUSHJ P,SCAN
PUSHJ P,READNM
NERROR ILC
SKIPE RSW ;THIS SWITCH NOT ALLOWED
NERROR ILC
DONNAM: MOVE T1,JOBREL ;SET THINGS UP
MOVEM T1,SVJRL2
ADDI T1,4000 ;ASK FOR 1 K FOR BUFFERS
TLO FL,ISCOP ;TELL THE WORLD WHAT WE HAVE DONE
CALLI T1,11 ;IS IT THERE?
NERROR NEC
MOVE T1,SVJRL2 ;POINT BUFFERS TO RIGHT PLACE
MOVEM T1,JOBFF
INIT ALTDV,14 ;GET IT
SIXBIT /DSK/
ALTBF
NERROR DNA ;MAYBE ITS HEREDITARY
PUSH P,NAMI+3 ;SAVE THIS BEFORE THE LOOKUP DESTROYS IT
LOOKUP ALTDV,NAMI
NERROR FNF
INBUF ALTDV,2 ;GET BUFFER SPACE
MOVE T1,ORGPPN ;SAVE OLD NAMES
EXCH T1,(P) ;AND REPLACE BY NEW
MOVEM T1,ORGPPN ;IN CASE WE HAVE TO BACK UP
MOVE T1,NAMI
PUSH P,ORGNAM
MOVEM T1,ORGNAM
HLLZ T1,NAMI+1
PUSH P,ORGEXT
MOVEM T1,ORGEXT
MOVE T1,JOBREL
SUBI T1,2*MXWPL+2 ;SET UP THE VARIOUS POINTERS
PUSH P,FILPT ;SEE STPT FOR MORE INFO
MOVEM T1,FILPT
MOVEI T1,1
PUSH P,CPGL
MOVEM T1,CPGL
MOVE T1,[ASCID /00000/]
PUSH P,CLN
MOVEM T1,CLN
MOVE T1,JOBFF
SETZM (T1)
ADDI T1,1
PUSH P,BUFP
MOVEM T1,BUFP
MOVE T1,JOBREL
SUB T1,BUFP
MOVE T2,T1
SUBI T2,MXWPL+1
PUSH P,MAXWC
MOVEM T2,MAXWC
ASH T1,-1
PUSH P,HLFWC
MOVEM T1,HLFWC
MOVEI T1,1
PUSH P,CPG
PUSH P,INPG
MOVEM T1,CPG
MOVEM T1,INPG
PUSH P,PNTR
MOVE PNTR,BUFP
PUSH P,SVWD
SETZM SVWD
PUSH P,OLDLIN
SETZM OLDLIN
PUSH P,WC
SETZM WC
MOVSI T1,1
PUSH P,BGPG
MOVEM T1,BGPG
MOVE T1,FL ;SAVE SELECTED FLAGS
AND T1,[XWD TECOF+FSTOPF,READOF!BOF!EOF!EOF2!BGSN]
PUSH P,T1
TRZ FL,EOF!EOF2
TRO FL,READOF!BOF
TLZ FL,TECOF
TLO FL,FSTOPF
MOVEM P,COPDL ;SAVE PDL FOR LATER
TLO FL,COPFIL ;WE ARE USING OTHER FILE POINTERS
PUSHJ P,FILLBF
SKIPN SSW
JRST COPY1
TRNN FL,TERMF ;MUST END HERE
NERROR ILC
TLO FL,SRCOP ;SET THINGS UP
JRST COMND ;AND GO GET COMMANDS
↑DSCOP: TLZ FL,SRCOP ;TURN IT OFF
MSSG (T1,SOURCE LINES=)
SETZM LOLN ;THIS MAY HAVE GOTTEN RESET
SETZM SAVCHR ;CLEAR THINGS OUT
SETZM TIBUF+2 ;CLEAR REST OF INPUT
JRST COPY1A ;GO GET REST OF COMMAND STRING
RSCOP: POP P,T2
MOVE P,COPDL ;GET PDL BACK
POP P,T1
TRZ FL,READOF!BOF!EOF!EOF2!BGSN ;RESTORE SELECTED FLAGS
TLZ FL,TECOF!FSTOPF
IOR FL,T1
POP P,BGPG
POP P,WC
POP P,OLDLIN
POP P,SVWD
POP P,PNTR
POP P,INPG
POP P,CPG
POP P,HLFWC
POP P,MAXWC
POP P,BUFP
POP P,CLN
POP P,CPGL
POP P,FILPT
POP P,ORGEXT ;GET NAMES BACK
POP P,ORGNAM
POP P,ORGPPN
JRST (T2) ;NOW RETURN
↑COPGET:SOSG ALTBF+2 ;GET A WORD FROM COPY FILE
JRST GETDO
GETWD1: ILDB T3,ALTBF+1
JUMPE T3,COPGET
POPJ P,
GETDO: INPUT ALTDV,0
STATO ALTDV,760000
JRST GETWD1
STATZ ALTDV,740000
ERROR DIE
TRO FL,EOF
MOVEI T3,0
POPJ P,
↑CKTEC2:SETSTS ALTDV,0
MOVSI T3,(<POINT 7,0>)
HLLM T3,ALTBF+1
MOVEI T3,5
IMULM T3,ALTBF+2
AOS ALTBF+2
JRST RDTECO
BEND COPY
SUBTTL PRINT ROUTINE
BEGIN PRINT
↑PRINT: SETZM LOLN ;AS A FLAG IN CASE OF /C OR /A,/C
PUSHJ P,SCAN
CAIE C,"," ;IS THERE A SWITCH?
JRST PRNT5 ;NO
PUSHJ P,SCAN ;YES, GET IT
TRO FL2,SUPN ;SUPPRESS LINE NUMBERS
PUSHJ P,SCAN ;SCAN PAST IT
PRNT5: TRNE FL,TERMF
JRST [MOVE T1,CLN ;MAKE P WITH NO ARGS DO P.!16
MOVEM T1,LOLN
MOVE T1,CPGL
MOVEM T1,LOPG
MOVEI T1,=16
MOVEM T1,SVCNT
TRO FL,CNTF
JRST PRCNT]
PUSHJ P,GET2 ;GET A DOUBLE STRING
CAIE C,"," ;I{S THERE A SWITCH?
JRST PRNT6 ;NO
PUSHJ P,SCAN ;YES, GET IT
TRO FL2,SUPN ;SUPPRESS LINE NUMBERS
PUSHJ P,SCAN ;SCAN PAST
PRNT6: TRNN FL,TERMF ;DID IT END WITH A TERMINATOR
NERROR ILC ;NO, ILLEGAL
PRCNT: TRZ FL,LINSN ;USE THIS AS A FLAG TO CHECK FOR NULL RANGE
↑RPGPRN:MOVE T1,LOPG ;FIND THE FIRST LINE WANTED
MOVEM T1,DPG ;SET IT AS THE ONE WE WANT
MOVE SINDEX,LOLN ;PICK UP THE LINE
PUSHJ P,FIND ;GO GET IT
SKIPE LOLN ;DID WE WANT TO PRINT AN ENTIRE PAGE
JRST PRNT1 ;NO, GO CHECK BOUNDS
MOVE T2,CPG ;WHICH ONE ARE WE ON
MOVEM T2,CPGL
PUSHJ P,PGPRN ;PRINT THE PAGE HEADER
TRO FL,LINSN ;THIS CAN COUNT AS A LINE
PRNT1: PUSHJ P,ONMOV ;CHECK TO SEE IF STILL IN RANGE
JRST EPRNT ;NO, END
TRO FL,LINSN ;WE HAVE SEEN ONE
CAMN T1,PGMK ;IS IT A PAGE MARK?
JRST PRNT3 ;YES, DO SOMETHING SPECIAL
MOVEM T1,CLN
MOVEM T2,CPGL ;SAVE PAGE TOO
MOVE T1,PNTR ;GET THE POINTER TO IT
PUSHJ P,OUTLIN ;AND PRINT
PRNT4: PUSHJ P,FINDN ;GET THE NEXT LINE
JRST PRNT1 ;AND CONTINUE
PRNT3: MOVEM T2,CPGL
TRNN FL2,SUPN ;UNLESS PRINTING A CLEAN COPY,
PUSHJ P,PGPRN ;GO PRINT A PAGE HEADER
AOS CPG
MOVE T2,[ASCID /00000/]
MOVEM T2,CLN ;SET LINE TO FIRST ON THAT PAGE
JRST PRNT4 ;AND CONTINUE
EPRNT: TRZN FL,LINSN ;DID WE PRINT SOMETHING
NERROR NLN ;NO, ERROR
JRST COMND ;YES, RETURN FOR COMMAND
BEND PRINT
SUBTTL LIST ROUTINE
BEGIN LIST
↑LIST: TRZ FL2,SUPN ;ASSUME WE ARE GOING TO LIST LINE NUMBERS
SETZM LOLN ;FOR START OF PAGE
IFN STANSW,< ;REG SPOOLING FEATURE.
;AT STANFORD, "LS" COMMAND LISTS TO A FILE AND SPOOLS IT
SETZM SPOOLR ;ASSUME NOT SPOOLING.
PUSHJ P,GNCH ;GET THE NEXT CHARACTER INTO C
CAIE C,"S"
CAIN C,"s"
SOSA SPOOLR ;SET FLAG AND SKIP
MOVEM C,SAVC ;CHARACTER NOT S. PUSH IT BACK WHERE SCAN
;WILL SEE IT NEXT TIME THRU.
>
PUSHJ P,SCAN ;SCAN THE NEXT STUFF
CAIE C,"," ;IS THERE A SWITCH?
JRST LIST9 ;NO
PUSHJ P,SCAN ;YES, SCAN FOR IT
MOVS T1,ACCUM
CAIE T1,'S ' ;IS IT S?
NERROR ILC ;NO, LOSE
TRO FL2,SUPN ;YES, SUPPRESS LINE NUMBERS
PUSHJ P,SCAN ;AND SCAN PAST IT
LIST9: TRNN FL,TERMF ;JUST A TERMINATOR
JRST LIST7 ;NO, GO LOOK FOR A COMMAND STRING
MOVEI T1,1 ;LIST ENTIRE FILE
MOVEM T1,LOPG
MOVSI T1,1 ;FROM 1 TO IMPOSSIBLY HIGH
MOVEM T1,HIPG
TRZ FL,CNTF ;MAKE SURE THAT THIS FLAG IS OFF
JRST LIST8 ;GO START WORK
LIST7: PUSHJ P,GET2 ;HAVE ALREADY SCANNED, GET 2 NUMBERS
CAIE C,"," ;IS THERE A SWITCH?
JRST LIST10 ;NO
PUSHJ P,SCAN ;YES, SCAN FOR IT
MOVS T1,ACCUM
CAIE T1,'S ' ;IS IT S?
NERROR ILC ;NO, LOSE
TRO FL2,SUPN ;YES, SUPPRESS LINE NUMBERS
PUSHJ P,SCAN ;AND SCAN PAST IT
LIST10: TRNN FL,TERMF ;END OK?
NERROR ILC
CAIN C,200
TRO FL2,SUPN ;SUPPRESS LINE NUMBERS IF ALTMODE
LIST8: TRZ FL,LINSN ;NONE SEEN YET
MOVEI T1,LPTBUF ;GET SET TO INIT THE LPT
MOVEM T1,JOBFF
COMMENT /REG/
COMMENT/WE USE OPEN INSTED OF INIT SO WE CAN SELECT
OUR OUTPUT DEVICE AT RUN TIME.
/
IFE STANSW,<MOVEI T1,100 ;USING MODE 100>
IFN STANSW,<MOVEI T1,1>
MOVEM T1,OPENBK
MOVSI T1,'LPT'
SKIPE SPOOLR
MOVSI T1,'DSK'
MOVEM T1,OPENBK+1
MOVSI T1,LOBUF
MOVEM T1,OPENBK+2
OPEN LPT,OPENBK
NERROR UNA ;CAN NOT GET IT
IFN STANSW,< ;SPOOLING FEATURE
SKIPN SPOOLR
JRST LIST01
MOVE T1,ORGNAM
MOVEM T1,OPENBK
MOVSI T1,'$$/' ;Stopgap Spooled Listing
MOVEM T1,OPENBK+1
LST002: HLRZ T1,OPENBK+1
ADDI T1,1
HRLZM T1,OPENBK+1
SETZM OPENBK+2
SETZM OPENBK+3
LOOKUP LPT,OPENBK
JRST .+2
JRST LST002
HRLZM T1,OPENBK+1
SETZM OPENBK+2
SETZM OPENBK+3
ENTER LPT,OPENBK
NERROR UNA ;HAVE TO GIVE SOME SORT OF ERROR
LIST01:
> ;END REG SPOOLING FEATURE.
OUTBUF LPT,1 ;ASK FOR ONE BUFFER
MOVEI T2,LPTBUF ;FIND OUT HOW BIG IT IS
EXCH T2,JOBFF
SUBI T2,LPTBUF ;THE SIZE
MOVEI T1,203*2+1 ;THE SPACE RESERVED FOR IT
IDIV T1,T2 ;GET NUMBER THAT WILL FIT THERE
OUTBUF LPT,(T1) ;AND ASK FOR THAT MANY
MOVE T1,[XWD PGHS,PGHD] ;GET A COPY OF THE BLANK HEADER
BLT T1,PGHD+11
MOVE C,[POINT 7,PGHD,27] ;START TO FILL IT
MOVEI T3,6 ;6 CHRS IN FILE NAME
MOVE T2,ORGNAM ;USE THE ORIGINAL NAME
PUSHJ P,PRTSX ;PUT IT IN THE HEADER
SKIPN T2,ORGEXT ;GET THE EXTENSION
JRST LIST1 ;NONE THERE, IGNORE
MOVEI T1,"." ;A DOT BETWEEN
IDPB T1,C
MOVEI T3,3 ;ONLY 3 CHRS HERE
PUSHJ P,PRTSX
LIST1: MOVE ALTP,[POINT 7,PGHD+3] ;TIME+DATE (ALTP IS FREE)
CALLI T1,14 ;GET DATE
IDIVI T1,=31 ;LEAVES DAY IN T2
PUSH P,T2 ;SAVE IT
IDIVI T1,=12 ;LEAVES MONTH IN T2 YEAR IN T1
EXCH T1,(P) ;INVERT ORDER OF DAY AND YEAR
PUSH P,T1 ;AND SAVE
MOVEI T1,1(T2) ;GET MONTH (MUST ADD 1)
MOVEI T3,HDOCH ;PLACE FOR DECPR TO PUT THINGS
PUSHJ P,DECPR
MOVEI T1,"/" ;SEPERATE
IDPB T1,ALTP
POP P,T1 ;THE DAY
ADDI T1,1
PUSHJ P,DECPR ;PRINT IT TOO
MOVEI T1,"/"
IDPB T1,ALTP
POP P,T1 ;THE YEAR
ADDI T1,=64 ;CONVERT TO REAL YEAR
PUSHJ P,DECPR
IBP ALTP ;SKIP OVER A SPACE
CALLI T1,23 ;GET THE TIME
IDIVI T1,=60000 ;CONVERT TO MINUTES
IDIVI T1,=60 ;NOW TO HOURS
PUSH P,T2 ;SAVE MINUTES
PUSHJ P,DECPR ;PRINT
MOVEI T1,":"
IDPB T1,ALTP
POP P,T1 ;GET MINUTES BACK
MOVEI T2,"0" ;MAKE SURE THERE ARE 2 DIGITS
CAIG T1,=9
IDPB T2,ALTP
PUSHJ P,DECPR
SETZM LOGPG ;LOGICAL PAGE TO 0
MOVE T1,LOPG ;GET SET TO PRINT
MOVEM T1,DPG
MOVE SINDEX,LOLN
PUSHJ P,FIND ;GO FIND IT
SETZM LSTCNT ;COUNT OF NUMBER OF LINES PER PAGE
LST2: PUSHJ P,ONMOV ;CHECK RANGE
JRST LST6 ;FINISH UP
TRO FL,LINSN ;YEP, WE HAVE SEEN ONE
CAMN T1,PGMK ;CHECK FOR PAGE MARK AND HANDLE SPECIAL
JRST LST4
MOVEM T1,CLN ;THE CURRENT LINE
MOVEI T2,0 ;COUNT OF NUMBER OF CHRS SEEN
SOSG LSTCNT ;CHECK TO SEE IF RUN OUT
PUSHJ P,HDPRNT ;GO PRINT HEADING
LST2A: MOVE T1,PNTR ;GET THE POINTER
TRNN FL2,SUPN ;DO WE WANT TO SUPPRESS LINE NUMBERS?
JRST LST3A ;NO
AOS T1 ;YES, SKIP A WORD
HRLI T1,(<POINT 7,0,6>) ;AND A CHARACTER
ADDI T2,6 ;AND TELL PEOPLE WE HAVE DONE SO
JRST LST3 ;BEFORE GOING ON OUR WAY
LST3A: HRLI T1,(<POINT 7,0>) ;AND SET UP BYTE POINTER
LST3: ILDB C,T1 ;GET CHR
IFE STANSW, <SKIPL C,LPTAB(C) ;GET LPT EQUIV AND CHECK FOR SPECIAL>
IFN STANSW, <SKIPL LPTAB(C)>
JRST SPHD
IFE STANSW,< TLNN C,200000
JRST LST5
PUSH P,C
MOVEI C,"?"
PUSHJ P,POCHR
ADDI T2,1
POP P,C
LDB C,[POINT 7,CTBL(C),10]>
LST5: PUSHJ P,POCHR ;PRINT IT
AOJA T2,LST3 ;COUNT AND CONTINUE
SPHD: CAIN C,12 ;LINE FEED IS END OF LINE
JRST [PUSHJ P,POCHR ;PRINT IT
PUSHJ P,FINDN ;GET NEXT
JRST LST2] ;AND GO
CAIN C,11 ;COUNT SPECIAL FOR TAB
JRST [PUSHJ P,POCHR
ADDI T2,10
ANDCMI T2,7
JRST LST3]
CAIN C,15
JRST [ MOVNI T2,1
JRST LST5]
CAIN C,14
JRST [PUSHJ P,POCHR ;FORM FEED GETS A HEADING
PUSHJ P,HDPRNT
JRST LST3]
CAIN C,"\" ;NEEDS DELETE,DELETE
IFE STANSW, <JRST [MOVEI C,177
PUSHJ P,POCHR
JRST LST5] ;AND AGAIN>
IFN STANSW, <JRST LST5>
CAIE C,13 ;VERT.TAB
ERROR ICN ;CONFUSED
PUSHJ P,POCHR
MOVE T3,LSTCNT
CAIG T3,(%LPP+2)/3
JRST [PUSHJ P,HDPRNT
JRST LST3]
CAIG T3,(2*(%LPP+2))/3
MOVEI T3,(%LPP+2)/3
CAIL T3,(2*(%LPP+2))/3
MOVEI T3,(2*(%LPP+2))/3
MOVEM T3,LSTCNT
JRST LST3
LST4: MOVEI C,14 ;PRINT A FORM FEED
SOSLE LSTCNT ;BUT ONLY IF WE ARE NOT ALREADY THERE
PUSHJ P,POCHR
AOS T1,CPG ;GET PAGE CORRECTLY
MOVEM T1,CPGL
SETZM LOGPG ;ZERO LOGICAL PAGE AGAIN
MOVEI T2,0 ;THIS MUST BE ZERO SO GET IT THAT WAY
PUSHJ P,HDPRNT ;PRINT A HEADER
AOS LSTCNT ;INCREASE BY 1 TO MAKE IT COME OUT RIGHT
PUSHJ P,FINDN ;ADVANCE
JRST LST2 ;AND CONTINUE
LST6: RELEAS LPT,0 ;GET RID OF IT
TRZ FL2,SUPN ;TURN THIS OFF SO * PRINTS
IFN STANSW,< ;SPOOLING FEATURE
SKIPN SPOOLR
JRST LST600
;OPENBK IS KNOWN TO HAVE THE RIGHT NAME AND EXT
;THE RIGHT HALF OF EXT WORD MUST BE SET TO 1,
;FOR DELETE AFTER SPOOLING. I PRESUME THAT
;ALL OTHER BITS SHOULD BE OFF.
;OPENBK+2 AND OPENBK+3 SHOULD BE CLEARED.
MOVEI T1,1
HRRM T1,OPENBK+1
SETZM OPENBK+2
SETZM OPENBK+3
TRNE FL,LINSN ;ANY LINES THERE?
JRST LST599 ;YES. SPOOL THEM
INIT LPT,17 ;NOTHING THERE. DELETE FILE
SIXBIT /DSK/
0
NERROR UNA
LOOKUP LPT,OPENBK ;SEEK FILE
JRST LST598 ;NOT THERE
SETZB T1,T2 ;ZERO 4 WORDS
SETZB T3,T4
RENAME LPT,T1
JFCL
LST598: RELEAS LPT,
JRST LST600
LST599:
PUSHJ P,SPSUB
> ;END SPOOLING FEATURE
LST600: TRNN FL,LINSN ;SKIP IF LINES THERE
NERROR NLN ;NO LINES
MOVE T1,CPG ;SET UP PAGE
MOVEM T1,CPGL
JRST COMND ;AND GET MORE COMMANDS
POCHR: SOSG LOBUF+2 ;ROOM FOR MORE?
OUTPUT LPT,0
CAIL T2,=120 ;END OF LINE?
JRST [ MOVEI T2,0
SOSG LSTCNT
PUSHJ P,HDPRNT
JRST .+1]
IDPB C,LOBUF+1
POPJ P,
HDPRNT: PUSH P,T1 ;SAVE POINTER
TRNE FL2,SUPN ;IF PRETTY PRINTING
JRST HDPR3 ;WE DON'T REALLY WANT TO DO THIS
MOVEI C,15 ;GET TO LEFT OF PAGE
PUSHJ P,POCHR
MOVE T1,[POINT 7,PGHD] ;GET SET TO PRINT HEADER
HDPR1: ILDB C,T1 ;GET A CHARACTER
JUMPE C,HDPR2 ;DONE?
PUSHJ P,POCHR ;PRINT IT
JRST HDPR1 ;CONTINUE
HDPR2: PUSH P,T2 ;SAVE CHARACTER COUNT
MOVE T1,CPG ;GET CURRENT PAGE
MOVEI T3,POCHR ;WHERE TO PRINT IT
PUSHJ P,DECPR ;PRINT
MOVEI C,"-"
PUSHJ P,POCHR
AOS T1,LOGPG ;GET NEXT LOGICAL PAGE
PUSHJ P,DECPR
HDPR3: MOVEI C,15 ;NOW RET AND 2 LFDS
PUSHJ P,POCHR
MOVEI C,12
PUSHJ P,POCHR
PUSHJ P,POCHR
MOVEI T1,%LPP ;RESET LINE COUNT
MOVEM T1,LSTCNT
TRNN FL2,SUPN ;IF IN SUPPRESS MODE WE DID NOT SAVE
POP P,T2 ;GET BACK COUNT OF CHRS
JUMPE T2,TPOPJ1 ;IF 0 THEN ALL OK
MOVE T3,T2 ;GET COPY
MOVEI C," " ;PRINT CORRECT NUMBER OF SPACES
PUSHJ P,POCHR
SOJG T3,.-1
TPOPJ1: POP P,T1 ;RESTORE POINTER
POPJ P,
PRTSX: MOVEI T1,0 ;SET TO RECIEVE A CHR
LSHC T1,6 ;GQT ONE
ADDI T1,40 ;CONVERT
IDPB T1,C ;PUT IN HEADER
SKIPE T2 ;ONLY SPACES LEFT?
SOJG T3,PRTSX ;OR COUNT RUN OUT?
POPJ P, ;RETURN
HDOCH: IDPB C,ALTP ;PUT CHRS FROM DECPR INTO HEADER
POPJ P,
SUBTTL SPOOLER STUFF
IFN STANSW,< ;SPOOLING FEATURE
;DEFINITIONS FOR SPOOLER COMMAND FILE:
CFORM←←0
RQNAM←←1
RQJOB←←2
FSIZE←←5
RQTIME←←6
FNAME←←7
AEXT←←14
CBITS←←16
;INITIALIZE SPOOLER IF ONE DOES NOT ALREADY EXIST
INTSPL: TRNE T1,2 ;SKIP IF NO JOBS LOGGED IN.
JRST MULSPL ;OOPS MORE THAN 1 SPOOLER ALREADY
MOVEI T1,SPRUNB ;ADDRESS OF RUN BLOCK
CALL T1,[SIXBIT/WAKEME/] ;LOGIN A PHANTOM JOB
JRST NOWAKE ;WAKE UUO FAILURE
MOVEI T2,30 ;WAIT MAX OF 24 SECONDS
INTSPS: MOVEI T1,1 ;SLEEP REGISTER
SLEEP T1, ;SLEEP A WHILE
MOVE T1,SPLNAM
CALL T1,[SIXBIT/NAMEIN/]
SOJGE T2,INTSPS ;WAIT SOME MORE.
JUMPL T2,SPLCFN
POPJ P, ;RETURN
SPRUNB:
SPLNAM: SIXBIT /[LIST]/
SPLPPN: SIXBIT /SPLSYS/ ;WHERE TO FIND IT
0 ;KEEP THIS JOB RUNNING
SPSUB: MOVE T1,SPLNAM ;FIND SPOOLER STATUS
CALL T1,[SIXBIT/NAMEIN/]
PUSHJ P,INTSPL ;HAVE TO INIT SPOOLER
MOVEM T1,SPOOLR ;T1 HAS JOB NUMBER OF SPOOLER
JBTSTS T1,
TLNE T1,20000 ;SKIP UNLESS ERROR STOP
TTCALL 3,[ASCIZ/
The spooler has crashed. Your output will be printed after
the spooler is restarted.
/]
INIT LPT,17 ;OPEN A CHANNEL
SIXBIT /DSK/
0
NERROR UNA
MOVE T1,OPENBK
HLLZ T2,OPENBK+1
SETZB T3,T4
LOOKUP LPT,T1 ;SEEK FILE
JRST SPLOKF ;LOOKUP FAILED
MOVS T4,T4
MOVM T4,T4 ;GET WD COUNT
LSH T4,-7 ;MAKE BLOCK COUNT
;OK. NOW, ALL I HAVE TO DO IS SETUP LPTBUF AND WRITE THE FILE
SETZM LPTBUF
MOVE T1,[XWD LPTBUF,LPTBUF+1]
BLT T1,LPTBUF+177
MOVE T1,['NP ',,1]
MOVEM T1,LPTBUF+CFORM
GETPPN T1,
MOVEM T1,LPTBUF+RQNAM ;SAVE REQUESTORS NAME
MOVEM T4,LPTBUF+FSIZE
DATE T1, ;GET DATE
HRLZM T1,LPTBUF+RQTIME ;SAVE
TIMER T1, ;TIME OF DAY
IDIVI T1,=3600 ;MAKE MINUTES
HRRM T1,LPTBUF+RQTIME ;SAVE
MOVE T1,[XWD OPENBK,LPTBUF+FNAME]
BLT T1,LPTBUF+FNAME+3 ;SAVE FILE NAME
HLLO T1,ORGEXT ;GET ORIGINAL EXTENSION
MOVEM T1,LPTBUF+AEXT ;SAVE AS ALIAS.
CALL T1,['PJOB '] ;GET JOB NUMBER
HRLZM T1,LPTBUF+RQJOB
SETO T1,
TTYUUO T1,6
HRRM T1,LPTBUF+RQJOB
MOVEI T1,1
MOVEM T1,LPTBUF+CBITS ;SET DELETE AFTER LISTING
MOVEI T1,0
CALL T1,['DSKPPN'] ;FIND OUT IF WE ARE SOMEWHERE ELSE.
MOVEM T1,LPTBUF+FNAME+3 ;SAVE THE PPN.
DATE T1,
TIMER T2,
LSH T1,=24
OR T1,T2
AGAIN: MOVSI T2,'SPX'
SETZ T3,
MOVE T4,SPLPPN
LOOKUP LPT,T1
JRST .+2
AOJA T1,AGAIN
MOVSI T2,'SPX'
SETZ T3,
MOVE T4,SPLPPN
ENTER LPT,T1
AOJA T1,AGAIN
OUTPUT LPT,[IOWD 200,LPTBUF
0]
STATZ LPT,740000
NERROR DDE
CLOSE LPT,
RELEAS LPT,
SETZM LPTBUF
MOVE T1,[XWD LPTBUF,LPTBUF+1]
BLT T1,LPTBUF+37
MOVE T1,SPOOLR
MOVEI T2,LPTBUF
SEND T1
JFCL
POPJ P,
> ;SPOOLING FEATURE.
SUBTTL SPOOLING ERRORS AND OTHER STUFF
SPLCFN: TTYUUO 3,[ASCIZ/
I just made a spooler, but now I can't find it.
/]
JRST COMND
MULSPL: TTYUUO 3,[ASCIZ/Spsub: There are multiple spoolers. Everyone loses
/]
JRST COMND
SPLOKF: TTYUUO 3,[ASCIZ/Spsub: Lookup failed on listing file.
/]
JRST COMND
NOWAKE: TTYUUO 3,[ASCIZ/Spsub: WAKEME to intiate spooler failed.
/]
JRST COMND
BEND LIST
SUBTTL JUSTIFICATION ROUTINES -- SRS
BEGIN JUST ;JUSTIFY TEXT AND OTHER GROOVY THINGS
↑JUST: SETZM LOLN ;AS USUAL
TRZ FL2,JFFLG!JRFLG!JLFLG!JCFLG!JPER ;CLEAR FLAGS
TRNE FL,READOF ;BETTER NOT BE READ ONLY
NERROR ILC ;SO TELL HIM
PUSHJ P,GNCH ;GET A CHARACTER
CAIE C,"r"
CAIN C,"R"
TRO FL2,JRFLG ;R FOR RIGHT
CAIE C,"l"
CAIN C,"L"
TRO FL2,JLFLG ;L FOR LEFT
CAIE C,"c"
CAIN C,"C"
TRO FL2,JCFLG ;C FOR CENTER
CAIE C,"u"
CAIN C,"U" ;U FOR JUSTIFY
TRO FL2,JFFLG ;WHICH IS THE ONLY THING WHICH FILLS
TRNN FL2,JRFLG!JLFLG!JCFLG!JFFLG
JRST JOIN ;MUST BE LINE NUMBER FOR JOIN
PUSHJ P,GET2S ;GET RANGE
CKTERM: TRNN FL,TERMF ;THIS HAD BETTER BE A TERMINATOR
NERROR ILC ;HE REALLY BLEW IT
MOVE T1,LOPG ;GET SET TO FIND LINE
MOVEM T1,DPG
MOVE SINDEX,LOLN
MOVEM SINDEX,LIBUF ;ALSO SET NEW FIRST LINE TO SAME
PUSHJ P,FIND ;FIND IT
PUSHJ P,INITOL ;SET IT UP
MOVEM T1,LIBUF ;SET NEW LINE NUMBER SAME AS OLD
PUSHJ P,INITNL ;AND SET UP THE NEW ONE
SETZM TPNT ;TELL JGET THERE IS NOTHING IN LIBUF2
MOVE T1,LMAR ;SET LEFT MARGIN
TRNE FL2,JFFLG ;IF FILLING
MOVE T1,PMAR ;MAKE THIS START OF PARAGRAPH
SOS T1
MOVEM T1,INDNT ;FOR INDENTATION
MOVEM T1,LINL ;AND LINE LENGTH
;THIS IS THE PART THAT GETS A CHARACTER FROM THE OLD LINE
JGET: SKIPN TPNT ;IS THERE ANY UNPROCESSED TAIL?
JRST JGET1 ;NO, GET A CHARACTER
MOVE T1,ELIN ;ARE WE AT END OF LINE?
CAMN T1,TPNT
JRST JGET2 ;YES, START GETTING FROM OLD LINE
ILDB T1,TPNT ;NO, GET A CHARACTER
JRST JPUT ;AND PUT.
JGET2: SETZM TPNT ;END OF TAIL
JGET1: ILDB T1,PNTR ;LOAD A CHARACTER
AOS OCNT1 ;STEP CHARACTER COUNT
CAIE T1,15 ;IS THIS A CR?
JRST JGET3 ;NO,TEST FOR END OF LINE
TRNN FL2,JFFLG ;ARE WE FILLING?
JRST JGET4 ;NO, WE'RE THROUGH
MOVEI T1," " ;YES, MAKE IT A BLANK
JRST JPUT ;AND GO PUT
JGET3: CAIE T1,12 ;END OF LINE?
JRST JPUT ;NOT YET, SO GO PUT
JGET4: ;END OF LINE
HRRZ T1,PNTR ;CURRENT WORD IN BUFFER FOR DELETION
SUB T1,OPTR ;- START OF OLD LINE
AOS T1 ;+1 = WORD COUNT OF OLD LINE
MOVEM T1,OCNT ;FOR INSED
TRNN FL2,JFFLG ;IF WE ARE NOT FILLING
JRST JGETE ;DO WHAT WE HAVE TO DO
SETZM NCNT ;OTHERWISE WE DELETE OLD LINE
MOVE PNTR,OPTR ;WHICH STARTS HERE
PUSHJ P,INSED ;USING INSED
PUSHJ P,FINDN1 ;MAKE SURE WE`RE AT START OF NEXT ONE
PUSHJ P,INITOL ;DO SETUP ON IT AND CHECK RANGE
JGETF: ILDB T1,PNTR ;GET FIRST CHARACTER
AOS OCNT1 ;STEP CHARACTER COUNT
CAIE T1,11 ;IS IT A TAB
CAIN T1,15 ;OR CR?
JRST PARA ;YES, START A NEW PARAGRAPH
JRST JPUT ;NO, GO PUT
JGETE: MOVE T1,LINL ;LINE LENGTH
MOVEM T1,WRDL ;TO WRDL BECAUSE CR AS BLANK WAS DELETED
MOVEM ALTP,LWRD ;ALSO STORE POINTER TO END OF LINE
CAMLE T1,MAXL ;IF LINE WAS TOO LONG,
RERROR LTL ;TELL HIM SO
PUSHJ P,JSUB ;CLEAN UP NEW LINE AND PUT IT OUT
PUSHJ P,INITOL ;SET UP NEXT LINE
MOVEM T1,LIBUF ;SET NEW LINE NUMBER SAME AS OLD
SETZM TPNT ;NOTHING IN LIBUF2
JRST JGET2 ;START MUNCHING
;THIS IS THE PART THAT PUTS A CHARACTER INTO THE NEW LINE
JPUT: CAIE T1," " ;IS THIS A BLANK?
JRST JPUTN ;NO, CHECK SOME OTHER STUFF
TRNE FL2,JPER ;IF WE HAVE SEEN A PERIOD OR SOMETHING
TRNN FL2,JBLF ;AND THIS IS NOT THE FIRST BLANK
SKIPA
JRST JPUTN1 ;PERMIT IT ANYWAY BUT DON'T TELL ANYONE
TROE FL2,JBLF ;WAS THERE ONE BEFORE IT?
JRST JGET ;YES; WE DON`T WANT IT
TRNN FL2,JFFLG ;ARE WE FILLING?
TRZ FL2,JBLF ;NO, PERMIT AN EXTRA BLANK
AOS WCNT ;STEP WORDCOUNT
MOVE T2,LINL ;GET LENGTH SO FAR
MOVEM T2,WRDL ;AND SAVE IT FOR JSUB
MOVEM ALTP,LWRD ;AND STORE POINTER TO END OF WORD
JRST JPUT1 ;THEN PUT BLANKIN BUFFER
JPUTN: TRZ FL2,JBLF!JPER ;NOT A BLANK
CAIN T1,"." ;IS IT A PERIOD
TRO FL2,JPER
CAIN T1,":" ;OR COLON
TRO FL2,JPER
CAIN T1,"?" ;OR QUESTION MARK
TRO FL2,JPER
CAIN T1,"!" ;OR EXCLAMATION?
TRO FL2,JPER ;IF SO PERMIT EXTRA BLANKS
JPUTN1: MOVE T2,LINL ;LENGTH SO FAR
JPUT1: IDPB T1,ALTP ;DEPOSIT CHARACTER
ADD T2,WTBL@ ;WIDTH OF CHARACTER
CAIE T1,11 ;WAS THAT A TAB?
JRST JPUT2 ;NO
TRZE T2,7 ;YES. IF LAST 3 BITS ARE NONZERO
ADDI T2,10 ;WE WERN'T AT TAB POSITION
SETZM WCNT ;RESET WORDCOUNT
SETZM LWRD ;LAST WORD LOCATION
MOVEM ALTP,BLIN ;AND LOGICAL BEGINNING OF LINE FOR JSUB
TRNE FL2,JFFLG ;IF FILLING
TRO FL2,JBLF ;DELETE A FOLLOWING BLANK
JPUT2: MOVEM T2,LINL ;STORE NEW LENGTH
CAMLE T2,MAXL ;ARE WE OVER THE END?
JRST JPUTEL ;YES, END LINE WE ARE NOW ON
CAME ALTP,[POINT 7,LIBUF2+MXWPL,34] ;NO, HAVE WE FILLED BUFFER?
JRST JGET ;NOT YET, GET ANOTHER
JPUTEL: SKIPE LWRD ;ANY WORDS YET?
JRST JPUTE ;YES, PUT OUT LINE
RERROR LTL ;NO, TELL HIM LINE TOO LONG
MOVE T2,MAXL ;SAY LINE IS LONG ENOUGH
MOVEM T2,WRDL
JPUTE: TRNE FL2,JFFLG ;UNLESS WE'RE NOT FILLING (IN WHICH CASE THIS IS A MISTAKE)
PUSHJ P,JSUB ;MOVE OUT A NEW LINE, AFTER JUSTIFYING IT
JRST JGET ;THEN GET ANOTHER CHARACTER
;THIS PUTS OUT A NEW LINE
NLOUT: MOVEI T1,15 ;ADD A CR
IDPB T1,ALTP
MOVEI T1,12 ;AND A LF
IDPB T1,ALTP
HRRZ T1,ALTP ;LAST WORD OF LINE
SUBI T1,LIBUF ;-FIRST
AOS T1 ;+1=WORDCOUNT
MOVEM T1,NCNT ;FOR INSERTION INTO BUFFER
TRNE FL2,JFFLG ;IF FILLING
SETZM OCNT ;INSERT BEFORE
MOVE PNTR,OPTR ;ELSE REPLACE, THE OLD LINE
PUSHJ P,INSED ;DONE BY INSED
PUSHJ P,FINDN ;FIND OLD LINE
PUSHJ P,FILLB ;AND KEEP FROM LOSING IT
TRNN FL2,JFFLG ;IF NOT FILLING
JRST INITNL ;SET UP NEW LINE ON THE WAY BACK
MOVE T2,INCR ;INCR FOR LINE NUMBERS
MOVE T1,LIBUF ;OLD LINE NUMBER
PUSHJ P,ASCIAD ;ADD TO MAKE NEW ONE
MOVEM T1,LIBUF ;AND STORE IT AWAY
CAMG T1,MAXLN ;TOO HIGH?
JRST NLO2 ;NO, EXIT
AOS T1,CPG ;YES, WILL SOON BE ON NEXT PAGE
MOVEM T1,CPGL ;AND LOGICAL PAGE
AOS BGPG ;ADD ONE MORE PAGE
AOS INPG
AOS HIPG
MOVE T1,PGMK ;INSERT PAGEMARK
MOVEM T1,LIBUF ;IN LINE BUFFER
MOVE T1,[BYTE (7) 15,15,14] ;AND TEXT THEREOF
MOVEM T1,LIBUF+1
SETZM OCNT ;INSERT
MOVEI T1,2 ;2 WORDS
MOVEM T1,NCNT
PUSHJ P,INSED ;INTO TEXT FILE
MOVE T2,INCR ;INCR AGAIN
MOVEM T2,LIBUF ;TO MAKE FIRST LINE NUMBER
PUSHJ P,FINDN ;MOVE PAST IT
PUSHJ P,FILLB ;FILL BUFFER TO KEEP FROM LOSING IT
MSG (T1,PAGE MARK INSERTED)
NLO2: MOVE T1,OCNT1 ;CHARACTERS PROCESSED SO FAR
MOVEM PNTR,OPTR ;REMEMBER WHERE WE ARE
AOS PNTR ;SKIP LINE NUMBER
HRLI PNTR,(<POINT 7,0>) ;MAKE BYTE POINTER
NLO1: IBP PNTR ;TO MOVE PNTR BACK
SOJGE T1,NLO1 ;TO WHERE WE FOUND IT
JRST INITNL ;THEN SET UP NEW LINE ON WAY BACK
;THIS SETS UP A NEW OLD LINE FOR GET
INITOL: PUSHJ P,FINDN1 ;MAKE SURE WE ARE AT START OF LINE
INITO1: HRRZM PNTR,OPTR ;SAVE POINTER TO START OF LINE
PUSHJ P,ONMOV ;CHECK RANGE
JRST JSTEND ;FINISHED
CAMN T1,PGMK ;IS IT A PAGEMARK?
JRST INITOP ;YES
MOVEM T1,CLN ;NO, SET CURRENT LINE
MOVE T2,CPG ;AND PAGE
MOVEM T2,CPGL
SETZM OCNT1 ;NO CHARACTERS YET
SETZM TCHR ;NOT KNOWN TO BE START OF PARAGRAPH
AOS PNTR ;SKIP LINE NUMBER
HRLI PNTR,(<POINT 7,0>) ;MAKE BYTE POINTER
IBP PNTR ;SKIP INITIAL TAB
POPJ P, ;EXIT
INITOP: ;FOUND A PAGEMARK
TRNE FL2,JFFLG ;ARE WE FILLING?
JRST INITOD ;YES, DELETE IT
AOS T2,CPG ;NO, WE ARE ON NEW PAGE
MOVEM T2,CPGL
PUSHJ P,FINDN ;FIND NEXT LINE
PUSHJ P,FILLB ;HANG ON TO IT
JRST INITO1 ;AND SEE WHAT'S THERE
INITOD: SETZM NCNT ;DELETE PAGEMARK
MOVEI T1,2 ;2 WORDS LONG
MOVEM T1,OCNT
PUSHJ P,INSED ;USE INSED AS USUAL
SOS BGPG ;NOW HAVE ONE LESS PAGE
SOS INPG
SOS HIPG
JRST INITOL ;LOOK AT NEXT LINE
INITNL: SETZM LIBUF+1 ;CODE TO ZERO THE LINE BUFFER
MOVE T1,[XWD LIBUF+1,LIBUF+2]
BLT T1,LIBUF+MXWPL+1
MOVE ALTP,[POINT 7,LIBUF2] ;POINT ALTP AT START OF LIBUF2
MOVEI T1,11 ;TAB TO START LINE
IDPB T1,ALTP ;SO INSERT IT
MOVEM ALTP,BLIN ;AND SAVE LOGICAL BEGINNING OF LINE
TRO FL2,JBLF ; KEEP FROM INSERTING LEADING BLANKS
TRZ FL2,JPER
MOVE T1,LMAR ;SET LEFT MARGIN
SOS T1 ;MARGIN -1 = EXTRA BLANKS
MOVEM T1,LINL ;FOR EXTRA LINE LENGTH
MOVEM T1,INDNT ;AND INDENTATION
SETZB T1,WCNT ;AND THERE ARE NO WORDS YET
SETZM WRDL ;NOR CHARACTERS, FOR THAT MATTER
EXCH T1,LWRD ;RESET POINTER TO LAST WORD
MOVEM T1,TPNT ;BUT SAVE IT TO GET TAIL
POPJ P, ;RETURN
;THIS STARTS A NEW PARAGRAPH
PARA: MOVEM T1,TCHR ;STORE TERMINATING CHARACTER
SKIPE LWRD ;ANY WORDS YET?
PUSHJ P,JSUB ;YES, GET RID OF OLD LINE
MOVE T1,TCHR ;GET TERMINATOR BACK
SETZM TCHR ;DON'T CONFUSE PEOPLE
SETZM TPNT ;TELL JGET NOTHING REMAINS IN LIBUF2
SETZM INDNT ;IF TAB, NO SPECIAL INDENTATION
SETZM LINL
CAIN T1,11 ;IS IT A TAB?
JRST JPUT ;YES, PUT IT IN NEW LINE
PUSHJ P,JSUB ;MUST HAVE BEEN BLANK LINE
MOVE T1,PMAR ;SET PARAGRAPH MARGIN
SOS T1
MOVEM T1,INDNT
MOVEM T1,LINL
JRST JGET ;SO GET NEW CHARACTER
;THIS FINISHES EVERYTHING UP
JSTEND: SETOM TCHR ;FAKE END OF PARAGRAPH
SKIPE LWRD ;ANYTHING LEFT?
PUSHJ P,JSUB ;YES, GET RID OF IT
MOVE PNTR,OPTR ;GET BACK OLD POINTER
MOVE T1,(PNTR) ;GET LINE NUMBER
MOVEM T1,LIBUF ;SAVE NUMBER OF NEXT LINE
PUSHJ P,FINDB ;GET LINE LAST FILLED
MOVEM T1,CLN ;SET IT AS CURRENT LINE
EXCH T1,LIBUF
SKIPE T1 ;END OF FILE?
CAMN T1,PGMK ;PAGE MARK NEXT?
JRST COMND ;DON'T WORRY ABOUT ORDER
CAMG T1,LIBUF ;ORDER TROUBLE?
NERROR ORDER ;YES
JRST COMND ;NO, WE'RE THROUGH.
;AT LAST! THE JUSTIFICATION OF ALL THIS STUFF!
JSUB: MOVEM ALTP,ELIN ;SAVE END OF LINE FOR GET
MOVE ALTP,[POINT 7,LIBUF+1] ;WHERE TO DEPOSIT
MOVE T4,[POINT 7,LIBUF2] ;WHERE TO LOAD
MOVNS JFLOP ;PUT BLANKS IN OTHER SIDE THIS TIME
JSUB1: ILDB T1,T4 ;GET A CHARACTER
IDPB T1,ALTP ;AND MOVE IT
CAME T4,BLIN ;WAS THAT THE LAST TAB?
JRST JSUB1 ;NO, MOVE ANOTHER
SKIPN T5,LWRD ;IF NO WORDS THERE
MOVE T5,ELIN ;THIS IS WHERE TO STOP
SKIPN WRDL ;IF NOTHING IS THERE AT ALL
JRST NLOUT ;PUT OUT BLANK LINE
;NOW WE COMPUTE NUMBER OF BLANKS TO INSERT, IF ANY
SETZM T2
SETZM BPW
SETZM REM
TRNE FL2,JLFLG ;IF LEFT JUSTIFYING,
JRST JSUBM1 ;WE DON'T WANT ANY
MOVEI T1," "
MOVE T2,MAXL ;DESIRED LENGTH
SUB T2,WRDL ;-LENGTH WE HAVE = WHAT WE WANT
JUMPE T2,JSUBM1 ;IF ZERO, GO MOVE REST OF LINE
IDIV T2,@WTBL ;/WIDTH OF BLANK = BLANKS WE NEED
TRNE FL2,JCFLG ;IF CENTERING
ASH T2,-1 ;WE ONLY WANT HALF AS MANY
TRNE FL2,JRFLG!JCFLG ;IF NOT JUSTIFYING BOTH MARGINS
JRST JSUBM1 ;GO PUT IN SOME BLANKS
SOSLE WCNT ;IF LESS THAN 2 WORDS
SKIPE TCHR ;OR END OF PARAGRAPH
JRST JSUBM ;DON'T BOTHER
IDIV T2,WCNT ;BLANKS/WORDS
MOVEM T2,BPW ;= BLANKS PER WORD
MOVEM T3,REM ;AND REMAINDER
SKIPL JFLOP
JRST JSUBM
AOS BPW ;EVERY OTHER LINE
SUB T3,WCNT ;WE ADD EXTRA BLANKS
MOVNM T3,REM ;ON THE OTHER SIDE
JSUBM: SETZM T2
;MOVE LINE, INSERTING BLANKS
JSUBM1: ADD T2,INDNT ;DO INDENTATION
JSUBM3: SOJL T2,JSUBM2 ;QUIT IF NONE
IDPB T1,ALTP ;ELSE DEPOSIT
SOJGE T2,.-1 ;AND TRY AGAIN
JSUBM2: CAMN T4,T5 ;WAS IT THE LAST?
JRST NLOUT ;YES, PUT OUT NEW LINE
ILDB T1,T4 ;GET ANOTHER CHARACTER
IDPB T1,ALTP ;DEPOSIT IT
SKIPN TCHR ;AT END OF PARAGRAPH WE DO NOT LOOK FOR BANKS
TRNN FL2,JFFLG ;ARE WE LOOKING FOR BLANKS?
JRST JSUBM2 ;NO, MOVE ANOTHER
JSUBB: CAIE T1," " ;YES, IS IT A BLANK?
JRST JSUBBN ;NO
TROE FL2,JBLF ;YES, DID WE JUST SEE ONE?
JRST JSUBM2 ;YES, MOVE ANOTHER
MOVE T2,BPW ;NO, GET BLANKS PER WORD
SOSL REM ;IF REMAINDER STILL > 0
ADD T2,JFLOP ;ADD ANOTHER ON ALTERNATE LINES
JRST JSUBM3 ;AND PUT THEM IN
JSUBBN: TRZ FL2,JBLF ;NOT A BLANK
JRST JSUBM2 ;GET ANOTHER
BEND JUST
SUBTTL "←" SET PARAMETERS ROUTINE
BEGIN SET
↑SET: PUSHJ P,SCAN ;GET THE THING TO SET TO
TRNN FL,IDF ;MUST BE AN IDENT
NERROR ILC
PUSH P,ACCUM ;SAVE IT
PUSHJ P,SCAN ;AND CHECK FOR TERMINATOR
CAIN C,"=" ;IS IT AN =?
JRST SETVAR ;YES, SET SOME VARIABLE
TRNN FL,TERMF ;NO, SHOULD BE TERMINATOR
NERROR ILC
POP P,T1 ;SHOULD BE "UPPER" OR "LOWER"
MOVNI T2,1 ;CHECK
CAMN T1,[SIXBIT /UPPER/]
MOVEI T2,0 ;USE 0 FOR UPPER CASE
CAMN T1,[SIXBIT /LOWER/]
MOVEI T2,40 ;AND 40 FOR LOWER
SKIPGE T2 ;DID WE SET ONE OR THE OTHER
JRST SET1 ;TEY FOR MODEL NUMBER
MOVEM T2,CASEBT ;SET UP CASE
JRST COMND
SET1: CAMN T1,[SIXBIT /M37/] ;MODEL 37?
JRST SETM37
CAMN T1,[SIXBIT /DPY/]
JRST SETDPY
CAMN T1,[SIXBIT /NOVICE/]
JRST SETNOV
CAMN T1,[SIXBIT /EXPERT/]
JRST SETEXP
CAMN T1,[SIXBIT /C128/]
JRST QON
CAMN T1,[SIXBIT /C64/]
JRST QOFF
CAME T1,[SIXBIT /M33/] ;OR 33
NERROR ILC ;LOSE
TRZA FL,M37F ;MODEL 33
SETM37: TRO FL,M37F
TRZ FL,DPYF ;IN NEITHER CASE IS IT A DISPLAY
JRST COMND
SETDPY: TRZ FL,M37F ;NOT A MODEL 37
TRO FL,DPYF ;BUT IS A DISPLAY
JRST COMND
QON: TLZA FL,QMODF
QOFF: TLO FL,QMODF
JRST COMND
SETNOV: TRZA FL,EXTOG
SETEXP: TRO FL,EXTOG
JRST COMND
SETVAR: PUSHJ P,SCAN ;GET A NUMBER
TRNN FL,NUMF ;IT HAD BETTER BE ONE
NERROR ILC
PUSH P,T2 ;SAVE IT
PUSH P,T1 ;IN BINARY AND ASCII
PUSHJ P,SCAN ;CHECK FOR TERMINATOR
TRNN FL,TERMF ;WHICH HAD BETTER BE THERE
NERROR ILC
POP P,T1 ;GET BACK ASCID
POP P,T2 ;BINARY
POP P,T3 ;AND THE IDENTIFIER
CAME T3,[SIXBIT /RMAR/]
JRST SETV2
MOVEM T2,RMAR ;RIGHT MARGIN FOR JUSTIFY
JRST COMND
SETV2: CAME T3,[SIXBIT /MAXLN/]
JRST SETV3
MOVEM T1,MAXLN ;MAXIMUM LINE NUMBER
JRST COMND
SETV3: CAME T3,[SIXBIT /INC/]
JRST SETV4
MOVEM T1,INCR ;LINE NUMBER INCREMENT FOR EVERYONE
JRST COMND
SETV4: CAME T3,[SIXBIT /LMAR/]
JRST SETV5
MOVEM T2,LMAR ;LEFT MARGIN FOR JUSTIFY
JRST COMND
SETV5: CAME T3,[SIXBIT /PMAR/]
JRST SETV6
MOVEM T2,PMAR ;PARAGRAPH STARTING POINT
JRST COMND
SETV6: CAME T3,[SIXBIT /SAVE/]
JRST SETV7
MOVEM T2,SAVNUM ;# OPERATIONS BETWEEN SUGGESTED "W"'S
MOVEM T2,SAVCNT ;INITIALIZE COUNTER TO THAT VALUE TOO
JRST COMND
SETV7: CAME T3,[SIXBIT /ISAVE/]
NERROR ILC
ADDI T2,1
MOVEM T2,ISVNUM ;INSERT MODE AUTO SAVE
MOVEM T2,ISVCNT
JRST COMND
BEND SET
SUBTTL "=" GIVE PARAMETERS ROUTINE
BEGIN GIVE
↑GIVE: PUSHJ P,SCAN ;FIND OUT WHAT HE WANTS TO KNOW
CAIN C,"." ;CURRENT LINE/PAGE?
JRST GVDOT ;YES
TRNN FL,IDF ;IF NOT, MUST BE AN IDENT
NERROR ILC
PUSH P,ACCUM ;SAVE IT
PUSHJ P,SCAN ;CHECK FOR TERM
TRNN FL,TERMF
NERROR ILC
POP P,T1 ;NOW FIND OUT WHAT HE WANTS
CAMN T1,[SIXBIT /ERROR/]
JRST GIVER
CAMN T1,[SIXBIT /CASE/]
JRST GVCASE
CAMN T1,[SIXBIT /STRING/] ;DOES HE WANT STRINGS?
JRST GVSTR
CAMN T1,[SIXBIT /INC/]
JRST GVINC ;CURRENT INCREMENT
CAMN T1,[SIXBIT /RMAR/]
JRST GVRM ;RIGHT MARGIN
CAMN T1,[SIXBIT /MAXLN/]
JRST GVMLN ;MAXIMUM LINE NUMBER
CAMN T1,[SIXBIT /LMAR/]
JRST GVLM ;LEFT MARGIN
CAMN T1,[SIXBIT /PMAR/]
JRST GVPM ;PARAGRAPH MARGIN
CAMN T1,[SIXBIT /SAVE/]
JRST GVSV ;# OPS BETWEEN SUGGESTED "W"'S
CAMN T1,[SIXBIT /ISAVE/]
JRST GVISV ;#OPS BETWEEN "W"'S IN INSERT MODE
CAMN T1,[SIXBIT /FILE/]
JRST GVFLNM ;TELL USER WHAT FILE HE'S EDITING
CAME T1,[SIXBIT /BIG/]
NERROR ILC ;NOTHING
TRNE FL,BGSN ;HAVE WE SEEN THAT PAGE
JRST GVBG1 ;YES, ALL IS OK
MOVSI T1,1 ;WILL HAVE TO SEARCH FOR IT
MOVEM T1,DPG
MOVEI SINDEX,0
PUSHJ P,FIND
TRNN FL,BGSN ;SHOULD HAVE SEEN IT NOW
ERROR ICN ;WE ARE IN TROUBLE
GVBG1: MOVE T1,BGPG ;GET IT
GIV2: MOVEI T3,OCHR ;ROUTINE FOR DECIMAL PRINTER TO OUTPUT TO
PUSHJ P,DECPR ;PRINT DECIMAL
OUTPUT TTY,0 ;FORCE OUTPUT
GIV1: TERPRI (T1)
JRST COMND
GVCASE: IFE FULDPX,<MOVEI T1,[ASCIZ /MODEL 37 /] ;TELL HIM HE'S A 37
TRNE FL,DPYF ;IF A DPY
MOVEI T1,[ASCIZ /DISPLAY /]
TRNE FL,M37F!DPYF ;BUT ONLY IF HE IS
CALLI T1,3
MOVEI T1,[ASCIZ /C64 /]
TLNE FL,QMODF
CALLI T1,3>
IFN FULDPX,<TRNE FL,DPYF
TTYUUO 3,[ASCIZ /DISPLAY /]
TRNE FL,M37F
TTYUUO 3,[ASCIZ /MODEL 37 /]
TLNE FL,QMODF
TTYUUO 3,[ASCIZ /C64 /]>
MOVEI T1,[ASCIZ /LOWER
/]
SKIPN CASEBT
MOVEI T1,[ASCIZ /UPPER
/]
CALLI T1,3 ;PRINT CURRENT CASE
JRST COMND
GIVER: SKIPN T1,SVERN
JRST COMND
IFE FULDPX,<MOVE T1,ETBL2-1(T1)
CALLI T1,3>
IFN FULDPX,<TTYUUO 3,@ETBL2-1(T1)>
JRST COMND
GVISV: MOVE T1,ISVNUM ;OPS BETWEEN "W"'S, INSERT MODE
JRST GIV2
GVSV: SKIPA T1,SAVNUM ;OPS BETWEEN "W"'S
GVRM: MOVE T1,RMAR ;RIGHT MARGIN
JRST GIV2
GVINC: SKIPA T1,INCR ;GET CURRENT INCREMENT
GVMLN: MOVE T1,MAXLN ;MAXIMUM LINE NUMBER
PUSHJ P,OUTSN
JRST GIV1
GVLM: SKIPA T1,LMAR ;LEFT MARGIN
GVPM: MOVE T1,PMAR ;PARAGRAPH LEFT MARGIN
JRST GIV2
GVDOT: PUSHJ P,SCAN ;SEE IF A TERMINATOR IS THERE
TRNN FL,TERMF
NERROR ILC ;NO TERMINATOR
MOVE T1,CLN ;GET CURRENT LINE
MOVEM T1,LINOUT
IFE FULDPX,<MOVEI T1,LINOUT ;NOW PRINT IT (FOLLOWED BY /)
CALLI T1,3>
IFN FULDPX,<TTYUUO 3,LINOUT>
MOVE T1,CPGL ;AND CURRENT PAGE
JRST GIV2 ;|O TO IT
GVSTR: MOVEI T1,SRPNT ;GET THE POINTER TO POINTER BLOCK
HRLI T1,-SRNUM ;SET COUNT
MSG (C, SEARCH:)
PUSHJ P,GVSTR3
MOVEI T1,R2PNT
HRLI T1,-SRNUM
MSG (C, SUBSTITUTE:)
PUSHJ P,GVSTR3
MOVEI T1,R1PNT
HRLI T1,-SRNUM
MSG (C,< FOR:>)
PUSHJ P,GVSTR3
JRST COMND
GVSTR3: SKIPN T2,(T1) ;IS THERE ONE THERE?
POPJ P, ;NO, DONE
GVSTR2: ILDB C,T2 ;NEXT CHR
JUMPE C,GVSTR1 ;DONE
PUSHJ P,OCHR ;PRINT IT
JRST GVSTR2 ;AND CONTINUE
GVSTR1: OUTPUT TTY,0 ;CLEAR OUTPUT DEVICE
TERPRI (T2)
AOBJN T1,GVSTR3 ;IF THERE IS ONE
POPJ P,
; GIVE USER FILE NAME
GVFLNM: MOVE T2,ORGNAM ;FILE NAME
PUSHJ P,SIXPRT ;PRINT IT
SKIPN T2,ORGEXT ;IS THERE AN EXTENSION?
JRST CHKPPN ; NO, CHECK PROJ/PROG
OUTSTR [ASCII /./] ;EXTENSION DELIM
PUSHJ P,SIXPRT ;EXTENSION NAME
; `W' CODE PUTS ORIGINAL EXT IN ORGPPN FOR SOME REASON --
; CHECK FOR IT BY TESTING RH
CHKPPN: SKIPE T2,ORGPPN ;PPN IN EDIT?
TRNN T2,-1 ;MAKE SURE REALLY A PPN
JRST CHKRON ;NO, CHECK READ-ONLY
OUTSTR [ASCII /[/]
HLLZS T2
PUSHJ P,SIXLJP ;LEFT-JUSTIFY, THEN PRINT
OUTSTR [ASCII /,/]
HRLZ T2,ORGPPN
PUSHJ P,SIXLJP
OUTSTR [ASCII /]/] ;FINISH UP
CHKRON: TRNE FL,READOF ;READ-ONLY?
OUTSTR [ASCII ./R.] ;YES
JRST GIV1 ;DONE
BEND GIVE
SUBTTL COMMON ROUTINES FOR SEARCH AND SUBSTITUTE ROUTINES
COMMENT ! SOME COMMON ROUTINES FOR SEARCHING FILES!
COMMENT ! THIS ROUTINE GENERATES CODE FOR FINDING A MATCH
FOR THE FIRST CHARACTER OF A SEARCH STRING. THE POINTER
TO A SET OF BYTE POINTERS FOR SEARCH STRINGS IS IN T1 !
BEGIN CODSR
UGGHH: TLC FL,NEGF
TLO FL,DEMCHR ;WE REALLY JEED IT
JRST READCH
↑CODSR: MOVEI T2,CODEBF ;SET UP POINTER TO PLACETO PUT CODE
MOVEI ALTP,0 ;THE NUMBER OF THE CURRENT STRING
HRLI T1,-SRNUM ;THE NUMBER OF STRINGS
CODS5: TLZ FL,NEGF!DEMCHR ;TURN OFF THE ¬ SEEN FLAG
MOVE T3,(T1) ;GET A POINTER
JUMPE T3,ENDCOD ;A ZERO BYTE POINTER IS END OF CODE
READCH: ILDB C,T3 ;PICK UP A CHARACTER IN STRING
JUMPE C,[TLNE FL,DEMCHR ;DID WE REALLY WANT ONE
NERROR ISS ;YES, LOSE
SUBI T2,2 ;NO, ALWAYS MATCH
JRST COMXCT]
CAIN C,"∞" ;ARBITRARY NUMBER OF SOMETHING
JRST ARBIT
CAIN C,"∀" ;ANY CHARACTER
JRST ANY
CAIN C,"¬" ;NOT THIS ONE
JRST UGGHH
CAIN C,"|" ;SEPARATOR
JRST SEP
CAIN C,"≡" ;QUOTE THE NEXT CHARACTER
JRST QUOTE
COMLET: MOVE CS,CTBL(C) ;GET THE MAJIC BITS
TLNN FL,EXCTS1!EXCTSR ;IS THIS AN EXACT SEARCH?
TLNN CS,LETF⊗16 ;OR NOT A LETTER
JRST NORMCR ;YES JUST THE TEST
HRLI C,(<CAIE C,>) ;DO A CAIE
MOVEM C,(T2)
XOR C,[<CAIN 40>≠<CAIE>] ;AND TEST FOR OTHER CASE
MOVEM C,1(T2)
TLNE FL,NEGF ;¬ THAT CHR
JRST GENSKP ;GENERATE A SKIPA
COMXCT: MOVE C,[XCT JSPR] ;THE CALL TO SEARCH FURTHER
DPB ALTP,[POINT 4,C,12] ;AC FIELD GIVES STRING NUMBER
MOVEM C,2(T2)
ADDI T2,3 ;ADVANCE OUTPUT POINTER
ENDSTR: ADDI ALTP,1 ;NEXT STRING
AOBJN T1,CODS5 ;IF ANY
ENDCOD: MOVE C,[JRST COMSRT] ;A RETURN
MOVEM C,(T2)
POPJ P,
SEP: MOVE C,[SKIPG CS,CTBL(C)] ;GET BITS
MOVEM C,(T2)
MOVE C,[TRNE CS,NSEPF] ;CHECK FOR %,$,OR .
MOVEM C,1(T2)
TLNE FL,NEGF ;SKIPA IN NORMAL CASE
JRST COMXCT
GENSKP: MOVSI C,(<SKIPA>)
MOVEM C,2(T2)
AOJA T2,COMXCT ;SO XCT WILL GO IN RIGHT PLACE
QUOTE: ILDB C,T3 ;GET NEXT CHR
JUMPE C,[NERROR ISS] ;END OF STRING IS ILLEGAL
JRST COMLET ;TREAT AS NORMAL CHARACTER
NORMCR: HRLI C,(<CAIN C,>) ;EXACT OR NOT LETTER
TLNE FL,NEGF
TLC C,(<CAIN>≠<CAIE>) ;USE OTHER TEST
NORMC1: MOVEM C,(T2)
SOJA T2,COMXCT ;MAKE THE XCT GO IN RIGHT PL@CE
ANY: MOVE C,[CAIE C,15] ;¬∀ IS 15
TLNE FL,NEGF
TLC C,(<CAIN>≠<CAIE>)
JRST NORMC1
ARBIT: ILDB C,T3 ;GET NEXT
CAIN C,"¬" ;JUST CHECK VALIDITY
JRST ARBIT
CAIN C,"≡"
ILDB C,T3
JUMPE C,[NERROR ISS] ;END OF STRING ERROR
JRST READCH ;LOOK FOR FIRST OTHER CHR
JSPR: JSP T1,SRCRET ;CALL CONTINUE SEARCH
BEND CODSR
;READ INTHE STRING TO SEARCH FOR
;T3 HAS PLACE TO PUT POINTERS T1 A BYTE POINTER FOR STRINGS
BEGIN SSTRNG
↑SSTRNG:MOVEI T2,SRBLG ;THE PERMISSIBLE LENGTH
HRLI T3,-SRNUM ;T3 HAS POINTER TO PLACE BYTE POINTERS
SSTR0: MOVEM T1,SVPT ;SAVE THE POINTER FOR END OF STRING
SSTR1: PUSHJ P,GNCH ;GET A CHR
CAIN C,200 ;ALTMODE TERMINATES
JRST SSTEND
CAIN C,15 ;IGNORE RETURNS
JRST SSTR1
CAIN C,12 ;LINE FEED IS END OF ONE STRING
JRST SSTR2
IDPB C,T1 ;PUT IN OUTPUT STRING
SOJG T2,SSTR1
SSTR3: RERROR STL ;THE STRING WAS TOO LONG
SSTR4: HRLZ T1,T3 ;ZERO OUT FIRST POINTER
MOVNS T1
ADDI T1,-SRNUM(T3) ;FIND START
SETZM (T1)
JRST COMND
SSTR2: CAMN T1,SVPT ;NULL STRING?
JRST [HLRZ C,T3 ;FIRST ONE?
CAIE C,-SRNUM ;WELL?
JRST .+1 ;NO
MOVEI C,12 ;RETURN A LINE FEED
POPJ P,]
↑RETSTR:MOVEI C,0 ;TERMINATE STRING WITH 0
IDPB C,T1
SOJLE T2,SSTR3
MOVE C,SVPT ;SET UP POINTER
MOVEM C,(T3)
AOBJN T3,SSTR0 ;IF ROOM FOR MORE, GET THEM
RERROR TMS ;TOO MANY GIVEN
JRST SSTR4
SSTEND: CAIN T2,SRBLG ;DID WE SEE ANY?
POPJ P, ;NO, RETURN
MOVEI C,0 ;YES, TERMINATE LAST
IDPB C,T1
MOVE T1,SVPT
MOVEM T1,(T3) ;SET POINTER
SSTR5: AOBJP T3,CPOPJ1 ;ZERO OUT OTHER POINTERS
SETZM (T3)
JRST SSTR5
BEND SSTRNG
;THE SEARCH ITSELF
BEGIN COMSRC
↑COMSRC:MOVEM T2,BUFSAV ;SAVE THE POINTER TO STRINGS
MOVNI T3,1 ;THE COUNT OF HOW FAR INTO LINE WE ARE
MOVEI ALTP,1(PNTR) ;SET BYTE POINTER
HRLI ALTP,(<POINT 7,0,6>)
MOVEI C,15 ;START WITH A LINE DELIMITER
JRST CODEBF ;GO SCAN
↑COMSRT:ILDB C,ALTP ;WE RETURN HERE IF NO MATCH FOR THIS ONE
CAIE C,15 ;DONE?
AOJA T3,CODEBF ;NO, GO ON
POPJ P, ;YES, NON-MATCH RETUNR
↑SRCRET:PUSH P,T1 ;SAVE THE RETURN ADDRESS
PUSH P,ALTP ;AND THE STRING POINTER
PUSH P,C ;AND THE CHARACTER
LDB T1,[POINT 4,-1(T1),12] ;GET STRING NUMBER
ADD T1,BUFSAV ;POINT TO BYTE POINTER
SKIPN T1,(T1) ;GET IT
ERROR ICN ;THERE SHOULD BE ONE THERE
MOVE T2,[POINT 7,ARBBUF] ;SET UP ARBIT MATCH
MOVEI T4,MXWPL*=10 ;POINTER AND COUNT
SETZM ARBCNT ;THE NUMBER OF ARBITRARY MATCHES SEEN
TLZ FL,ARBITG ;OFF AT START
PUSHJ P,LINMAT ;GO CHECK FOR MATCH
JRST LOSE ;WE LOSE, CONTINUE SCAN
MOVEM ALTP,SRCALP ;POINTER TO END OF STRING
POP P,C ;RESTORE
POP P,ALTP
POP P,T1
↑CPOPJ1:AOS (P) ;SKIP RETURN
POPJ P,
LOSE: POP P,C ;RESTORE
POP P,ALTP
POPJ P, ;AND CONTINUE SEARCH
NXTCHR: CAIN C,12 ;WAS THAT LAST OF LINE?
POPJ P, ;YES, LOSE
ILDB C,ALTP ;NO, TRY NEXT
LINMAT: PUSHJ P,CHRMAT ;CHECK FOR MATCH
POPJ P, ;NONE, RETURN
CAIE CS,0 ;IS SO ALL DONE
JRST NXTCHR ;NO, TRY MORE
JRST CPOPJ1 ;SKIP RETURN
BEGIN CHRMAT
↑CHRMAT:TLZ FL,NEGF!DEMCHR ;NO ¬ SEEN AND CHR CAN BE 0
READCH: ILDB CS,T1 ;GET NEXT
JUMPE CS,MATCH ;END OF STRING IS USUALLY GOOD
CAIN CS,"¬" ;CHEC FOR NEGATE
JRST [TLC FL,NEGF
TLO FL,DEMCHR ;MUST BE FOLLOWED BY A CHR
JRST READCH]
CAIN CS,"|" ;SEPERATOR?
JRST SEP
CAIN CS,"∞" ;ARBITRARY NUMBER
JRST ARBIT
CAIN CS,"∀" ;ANY?
JRST ANY
CAIN CS,"≡" ;QUOTE NEXT?
JRST [ILDB CS,T1
JUMPN CS,.+1 ;MUST HAVE ONE THERE
NERROR ISS] ;ELSE ILLEGAL
CAMN C,CS ;ARE THEY THE SAME
JRST ISTRU1 ;YES, CHECK NEGF
MOVE T5,CTBL(CS) ;GET BITS
TLNN FL,EXCTS1!EXCTSR ;EXACT?
TLNN T5,LETF⊗16 ;OR NOT LET
JRST ISFALS ;NO MATCH
XORI CS,40 ;CHECK OTHER CASE
CAMN C,CS
JRST ISTRU1
JRST ISFALS ;LOSE
MATCH: TLNE FL,DEMCHR ;DID WE NEED A CHARACTER THERE?
NERROR ISS ;YES, ILLEGAL STRING
JRST CPOPJ1 ;OK RETURN
ANY: CAIE C,15
JRST ISTRU ;YES THIS IS ANY CHR
ISFALS: CAIN C,15 ;IS IT A RETURN
AOSA T4 ;ADJUST COUNT AND ENTER A NULL STRING
IDPB C,T2 ;SAVE IN ARBIT
MOVEI T5,0
IDPB T5,T2
SUBI T4,2 ;COUNT THEM
JUMPLE T4,ILFMTR ;THIS LINE MUST HAVE ILLEGAL FORMAT
AOS ARBCNT ;ONE MORE SEEN
ISFAL1: TLNE FL,NEGF ;WAS NEG FLAG ON?
AOS (P) ;YES, A MATCH
POPJ P,
SEP: SKIPG T5,CTBL(C)
TRNE T5,NSEPF
JRST ISFALS ;NOT A SEP
ISTRU: CAIN C,15
AOSA T4
IDPB C,T2 ;SAVE CHR
MOVEI T5,0
IDPB T5,T2
SUBI T4,2
JUMPLE T4,ILFMTR
AOS ARBCNT
ISTRU1: TLNN FL,NEGF ;NEGATE?
AOS (P) ;NO, MATCH
POPJ P,
ILFMTR: MOVE T2,CPG ;GIVE HIM AN ERROR MESSAGE AND PAGE
PUSHJ P,PGPRN ;AND LINE
MOVE T1,(PNTR)
PUSHJ P,OUTSN
NERROR ILFMT
ARBIT: TLNN FL,NEGF ;THIS HAS NO MEANING
TLOE FL,ARBITG ;ARE WE SEEING ∞∞
NERROR ISS ;YES, ILLEGAL STRING
PUSH P,T1 ;SAVE SEARCH POINTER
MOVEI T5,0 ;SET ARBITRARY STRING TO NULL
IDPB T5,T2
SOJLE T4,ILFMTR
AOS ARBCNT
PUSH P,ARBCNT ;SAVE IN CASE WE COME BACK WITH NO MATCH
PUSH P,T2
PUSH P,T4
PUSH P,C
CHKTHS: TLO FL,DEMCHR ;NEED A CHARACTER NOW
PUSHJ P,READCH ;CALL SELF RECURSIVELY
JRST PROCED ;THIS COULD NOT MATCH JUST SCAN ON
MOVE T2,-3(P) ;RESTORE ARBIT COUNT
MOVEM T2,ARBCNT
MOVE T4,-1(P) ;AND ARBIT CHR COUNT
MOVE T2,-2(P) ;AND POINTER
PUSH P,ALTP ;SAVE CHR POINTER
TLZ FL,ARBITG ;CAN SEE ANOTHER ∞ NOW
PUSHJ P,LINMAT ;A MATCH
JRST RECUR ;NO, TRY FOR ANOTHER OF THAT CHR
SUB P,[XWD 7,7] ;GET ALL THAT JUNK OFF STACK
JRST CPOPJ1 ;AND RETURN TO CALLER OF LINMAT
RECUR: POP P,ALTP ;GET BACK POINTER
POP P,C ;AND CHR
MOVE T4,-2(P) ;RESTORE COUNT
MOVEM T4,ARBCNT
POP P,T4
POP P,T2 ;ALSO CHR COUNTER AND POINTER
DPB C,T2 ;PUT IN THAT CHR
MOVEI T5,0 ;AN@ TERMINATOR
IDPB T5,T2
SOJLE T4,ILFMTR
PUSH P,T2
PUSH P,T4 ;RESAVE
MOVE T1,-3(P) ;RESTORE SEARCH POINTER
ILDB C,ALTP ;GET ANOTHER CHR
PUSH P,C ;SAV IT
TLZ FL,NEGF ;TURN THIS OFF FOR RECURSION
CAIE C,12 ;END OF WORLD?
JRST CHKTHS
SUB P,[XWD 5,5] ;RECUCE STACK
POPJ P, ;AND ERROR RET
PROCED: TLZ FL,ARBITG!NEGF ;JUST GO ON
POP P,C
POP P,T4
POP P,T2
POP P,ARBCNT
POP P,(P) ;GET RID OF EXTRA POINTER
JRST CHRMAT ;CONTINUE MATCH SCANNING
BEND CHRMAT
BEND COMSRC
SUBTTL ERROR MESSAGE ROUTINES, UUO AND PDLOV HANDLERS
PDLOV: NERROR STC ;PUSH DOWN OVERFLOW
IFE TWOSGM,{
ERRHD: 0 ;THE ERROR HANDLER
}
ERRHDA: MOVEM T1,SVT1E ;SAVE T1 IN CASE OF RERROR
HRRZ T1,40 ;PICK UP THE ERROR NUMBER
SKIPE T1
CAILE T1,NUMER
ERROR ILUUO ;WRONG ERROR, CALL SELF
MOVEM T1,SVERN ;SAVE FOR =ERROR COMMAND
TRNE FL,EXTOG
SKIPA T1,ETBL-1(T1) ;(NN ZERO ERRORS) GET MESSAGE
MOVE T1,ETBL2-1(T1) ;GET LONG FORM
CALLI T1,3 ;AND PRINT
LDB T1,[POINT 9,40,8] ;GET UUO
CAILE T1,3
ERROR ILUUO ;IT WAS ILLEGAL
XCT ERND(T1) ;DO GOOD THING
JRST @ERRHD ;RERROR WILL FALL THROUGH XCT AND RETURN
ERND: ERROR ILUUO ;0 IS AN ERROR
HALT ;DIE
JRST COMND ;GO ON
MOVE T1,SVT1E ;RERROR- RESTORE T1
EDFLIN: MSG (T1,<TEMPORARY FILE IN USE. I GIVE UP>)
CALLI 12
NODSK: MSG (T1,<NO DISK AVAILABLE. PLEASE CHECK THE DISK YOU HAVE REQUESTED>)
CALLI 12
NOFIL: MSG (T1,FILE NOT FOUND)
JRST STPT
ILFN: MSG (T1,ILLEGAL FILE SPECIFICATION)
JRST STPT
DEFINE ERMS (A)
<FOR B⊂(A) <[ASCIZ /
*B*
/]
>>
ETBL: ERMS <ICN,DIE,DDE,ILC,ILUUO,LTL,NLN,NSP,ORDER,UNA,ILR>
ERMS <WAR,TMS,STL,ISS,ILFMT,NSG,FNF,DNA,NEC,IRS,STC,ITD>
ERMS <NNN,BKO>
NUMER←←.-ETBL
ETBL2: ERMS <INTERNAL CONFUSION,DEVICE INPUT ERROR>
ERMS <DEVICE OUTPUT ERROR,ILLEGAL COMMAND,ILLEGAL UUO>
ERMS <LINE TOO LONG>
[ASCIZ /
*NO SUCH LINE(S)*
/]
ERMS <NO SUCH PAGE>
ERMS <OUT OF ORDER,DEVICE NOT AVAILABLE,ILLEGAL REPLACEMENT>
ERMS <WRAP AROUND,TOO MANY STRINGS,STRING TOO LONG>
ERMS <ILLEGAL SEARCH STRING,ILLEGAL LINE FORMAT>
ERMS <NO STRING GIVEN,FILE NOT FOUND,DISK NOT AVAILABLE>
ERMS <INSUFFICIENT CORE AVAILABLE,ILLEGAL REPLACEMENT STRING>
ERMS <SEARCH STRING TOO COMPLEX,ILLEGAL TRANSFER DESTINATION>
ERMS <NO NEXT LINE,BREAK OUT>
SUBTTL TELETYPE I/O HANDLER, COMMAND PARSING ROUTINES
BEGIN GET2
;GET A PAIR OF FORM A/B,C/D LOLN IS SET BY CALLER BEFORE CALL
↑GET2S: PUSHJ P,SCAN
↑GET2: TRZ FL,CNTF ;NOT A ! COMMAND
PUSHJ P,GET1 ;GET A LINE AND PAGE NUMBER PAIR
MOVE T3,HIPG ;NOW SET LOWER PAGE TO THE ONE SEEN
MOVEM T3,LOPG
MOVE T3,HILN ;RESET LOW LINE IS A NUMBER SEEN
TRNE FL,LINSN
MOVEM T3,LOLN
↑GET2HF:MOVE T3,[ASCID /99999/] ;SET UP A LARGE NUMBER
TRNN FL,LINSN ;IF NO LINE NUMBER SEEN
MOVEM T3,HILN
TRZ FL,PGSN ;SO DELETE CAN DETECT A SECOND PAGE SPEC
CAIN C,"!" ;IS IT A ! COMMAND?
JRST GET2CT ;GO TAKE CARE OF IT
CAIE C,":" ;CHECK FOR SECOND SET
POPJ P, ;NOPE, RETURN
MOVEM T3,HILN ;SET HILN ANYWAY
JRST GETLAS ;AND GO GET THE SECOND PAIR
GET2CT: TRO FL,CNTF ;SET THE APPROPRIATE FLAG
PUSHJ P,SCAN ;THERE SHOULD BE A NUMBER HERE
TRNN FL,NUMF
NERROR ILC ;LOSE
MOVEM T2,SVCNT ;HANG ON TO IT
JRST SCAN ;SCAN NEXT AND RETURN
BEND GET2
BEGIN GET1
;ROUTINE SETS HIPG IN CASE NONE SEEN BY GETLA, THEN CALLS GETLA
↑GET1S: PUSHJ P,SCAN
↑GET1: MOVE T3,CPGL
MOVEM T3,HIPG
JRST GETLA
BEND GET1
BEGIN GETLA
;ROUTINE GETS A FULL SEQ NUMBER OF FORM A/B
↑GETLAS: PUSHJ P,SCAN
↑GETLA: TRZ FL,PGSN ;NO PAGE SEEN YET
PUSHJ P,GETL ;GET THE LINE NUMBER PART
MOVE T2,CPGL ;IN CASE LSRCH GOT A NEW PAGE
TRNE FL,PGSN ;DID LSRCH GET PAGE?
MOVEM T2,HIPG ;YES, USE IT
CAIE C,"/" ;IS THIS A PAGE COMMING?
JRST NOPG ;NO, A LINE NUMBER AT MOST
PUSHJ P,SCAN ;YES, GET THE PAGE NUMBER
SKIPLE T2 ;NUMBERS < OR = 0 LOSE
TRZN FL,NUMF ;WAS IT A NUMBER
NERROR ILC ;LOSE LOSE
TRO FL,PGSN ;YEP, WE SAW IT
MOVEM T2,HIPG ;SAVE THAT NUMBER
PUSHJ P,SCAN ;CHECK FOR + OR -
CAIN C,"+"
JRST PGPLS
CAIE C,"-"
JRST NOPG ;NO, GO DO ADSUB ON LINE NUMBER
PUSHJ P,SCAN ;GET THE NUMBER
TRZN FL,NUMF ;MUST BE A NUMBER
NERROR ILC
MOVE T1,HIPG
SUB T1,T2
MOVEM T1,HIPG ;FILL IN NUMBER
NOPGA: PUSHJ P,SCAN ;SCAN PAST NUMBER
NOPG: TRNN FL,LINSN!PGSN ;DID WE SEE A LINE OR A PAGE?
NERROR ILC ;NO, SOMETHING IS WRONG
PUSH P,T1 ;SAVE (HAVE ALREADY SCANNED)
PUSH P,T2
PUSHJ P,ADDSUB ;TAKE CARE OF + AND - FOR LINE
POP P,T2
POP P,T1
MOVEM SINDEX,HILN ;SAVE RESULT
POPJ P, ;AND RETURN
PGPLS: PUSHJ P,SCAN ;GET NUMBER TO ADD
TRZN FL,NUMF ;A NUMBER?
NERROR ILC ;NO, NERROR
ADDM T2,HIPG ;ADD IT IN
JRST NOPGA ;AND CLEAN UP
BEND GETLA
BEGIN GETL
;ROUTINE TO GET ONE LINE NUMBER FROM INPUT STREAM. HANDLES + AND -
↑GETLS: PUSHJ P,SCAN
↑GETL: TRZ FL,LINSN!ADDL!SUBL
TRZ FL2,STARF
CAIN C,"*"
JRST DOLST
CAIN C,200 ;DO WE HAVE TO SEARCH FOR IT
PUSHJ P,LSRCH ;OK THEN HERE WE GO
TRZN FL,NUMF
POPJ P, ;SCAN DID NOT SEE A NUMBER RETURN (CALLER CAN GIVER ERR)
MOVEM T1,HILN ;SAVE THE NUMBER HERE
GETL1: TRO FL,LINSN ;SET A FLAG TO SAY WE SAW THE LINE
PUSHJ P,SCAN ;SCAN FOR + OR -
CAIN C,"+"
JRST ADDNUM
CAIE C,"-"
POPJ P, ;NEITHER
TROA FL,SUBL ;SET SUBTRACT FLAG
ADDNUM: TRO FL,ADDL ;SET ADD FLAG
PUSHJ P,SCAN ;SCAN ANOTHER
TRZN FL,NUMF ;WAS IT A NUMBER
NERROR ILC ;ANYTHING ELSE IS ILLEGAL
MOVEM T2,SVINC ;SAVE IT
JRST SCAN ;RETURN AFTER SCANNING ONE MORE
DOLST: TRO FL2,STARF
JRST GETL1
BEND GETL
BEGIN ADDSUB
;ROUTINE TO RESOLVE THE + AND - IN THE LINE NUMBER. WE MUST WAIT
;UNTIL THE PAGE HAS BEEN DEFINED BEFORE DOING THIS
↑ADDSUB: MOVE SINDEX,HILN ;GET THE NUMBER
MOVE T1,HIPG ;GET THE REQUIRED PAGE
MOVEM T1,DPG ;AND SET IT AS THE DESIRED ONE
TRNN FL2,STARF
JRST DOAS
MOVE SINDEX,[ASCID /99999/] ;FIND A BIG LINE
PUSHJ P,FIND
CAME T1,[ASCID /99999/] ;IF ITS THERE ITS LAST
PUSHJ P,FINDB ;ELSE BACK UP
SKIPE T1 ;CHECK TO SEE IF EMPTY PAGE
CAMN T1,PGMK
SKIPA
MOVE SINDEX,T1 ;OK, USE ONE FOUND, ELSE LEAVE BIG
DOAS: TRZE FL,ADDL ;DID WE WANT TO ADD?
JRST ADLIN ;YES, GO ADD
TRZN FL,SUBL ;OR SUBTRACT?
↑CPOPJ: POPJ P, ;NO, RETURN
PUSHJ P,FIND ;GET THE DESIRED LINE
SUBL1: SOSGE SVINC ;DO WE WANT TO GO BACK STILL FARTHER
POPJ P, ;NO, ALL DONE
PUSHJ P,FINDB ;GET THE PREVIOUS LINE
SKIPE T1 ;0 MUST BE AT START OF BUFFER, QUIT
CAMN T1,PGMK ;WAS IT A PAGE MARK?
POPJ P, ;YES, AS FAR AS WE GO, SINDEX HAS CORRECT NUMBER
MOVE SINDEX,T1 ;THIS WILL DO
JRST SUBL1 ;GO TRY FOR MORE
ADLIN: PUSHJ P,FIND ;GET DESIRED LINE
CAME T1,PGMK ;WAS IT A PAGE MARK?
JUMPN T1,ADLIN1 ;OR 0 (I.E. END OF FILE)
POPJ P, ;RETURN WITH ORIGINAL NUMBER
ADLIN1: CAME T1,HILN ;SEE IF AN EXACT MATCH
SOS SVINC ;IF NO, ALREADY ARE +1
MOVE SINDEX,T1 ;GET THE WORD WE HAVE FOUND
ADLIN2: SOSGE SVINC ;NEED TO GO FURTHER
POPJ P, ;NO, RETURN RESULTS
PUSHJ P,FINDN ;GET THE NEXT LINE IN SEQUENCE
CAME T1,PGMK ;PAGE MARK?
JUMPN T1,.+2 ;OR EOF
POPJ P, ;YES, RETURN
MOVE SINDEX,T1 ;ACCEPT NEW NUMBER
JRST ADLIN2 ;AND LOOK FOR MORE
BEND ADDSUB
BEGIN LSRCH
COMMENT ⊗ ASSOCIATIVE LINE # ROUTINE -- WRITTEN BY SRS ⊗
;SEARCH FOR A LINE AND USE ITS NUMBER INSTEAD OF .
;MOSTLY PLAGIARIZED FROM SEARCH
↑LSRCH: PUSH P,SVINC ;SAVE PREVIOUSLY GATHERED LINE NUMBERS
PUSH P,SVCNT
PUSH P,HIPG
PUSH P,LOLN
PUSH P,LOPG
PUSH P,FL ;SAVE FLAGS IN CASE CALLED WITHIN SEARCH
PUSH P,FL2
TLZ FL,ASSMF ;CLEAR ALL FLAGS
SETZM LOLN ;JUST LIKE EVERYONE ELSE HAS TO
SETZM LLRCNT ;START WITH ZERO
SOSGE LSBUFN ;GET STRING BUFFER NUMBER
NERROR TMS ;NESTING TOO DEEP
MOVE T2,LSBUFN ;INDEX IN STRING BUFFER TABLES
MOVE T1,LSPTR(T2) ;SET UP BYTE POINTER
MOVE T3,LSPTT(T2) ;AND POINTER TO BYTE POINTER TABLE
PUSHJ P,SSTRNG ;GET A SEARCH STRING
JRST [MOVE T2,LSBUFN ;INDEX TO POINTERS
SKIPN @LSPTT(T2) ;WAS STRING SET?
NERROR NSG ;NO, TELL HIM
CAIN C,12
JRST ASSMD1 ;SPECIAL CONTINUE MODE
JRST .+1] ;YES, USE OLD ONE
TLZ FL,NUMSRF!DECID!EXCTSR ;CLEAR FLAGS
PUSHJ P,SCAN ;CHECK FOR WHAT COMES AFTER
TRNN FL,TERMF ;IF TERMINATOR
CAIN C,"," ;OR ,
JRST ASSMDT ;SET UP LIMITS SPECIALLY
CAIE C,"!"
CAIN C,":"
JRST ASSMDT ;LET HIM SPECIFY 2ND HALF OF RANGE
PUSHJ P,GET2 ;ELSE CALL USUAL LIMIT ROUTINE
SRC4: MOVE T1,HILN ;SAVE END OF RANGE
MOVEM T1,LLHILN
MOVE T1,HIPG
MOVEM T1,LLHIPG
CAIE C,"," ;ANY MORE ARGUMENTS?
JRST SRC1 ;NO, CHECK TERMINATOR AND PROCEED
PUSHJ P,SCAN ;YES, SEE WHAT IT IS
TRNN FL,IDF ;SHOULD BE IDENT OR NUMBER
JRST SRC2 ;NOT IDENT, CHECK FOR NUMBER OF SEARCHES
MOVS T1,ACCUM ;GET THE IDENT
CAIN T1,'N ' ;AND FIND OUT WHAT IT IS
TLO FL,NUMSRF!DECID
CAIN T1,'D '
TLO FL,DECID ;WANTS TO DECIDE ON LINE
TLNN FL,NUMSRF!DECID ;WAS IT EITHER?
JRST SRC3 ;NO, CHECK E
PUSHJ P,SCAN ;CONTINUE LOOKING
CAIE C,","
JRST SRC1 ;NO MORE ARGUMENTS
PUSHJ P,SCAN ;WELL WHAT KIND IS THIS ONE?
TRNN FL,IDF ;MORE IDENTS?
JRST SRC2 ;NO, MUST BE NUMBER OF SEARCHES
MOVS T1,ACCUM
SRC3: CAIE T1,'E '
NERROR ILC ;NO, HE MUST HAVE MADE A MISTAKE
TLO FL,EXCTSR ;YES, REMEMBER IT
PUSHJ P,SCAN ;AND CHECK FOR MORE
CAIE C,","
JRST SRC1 ;NO MORE
PUSHJ P,SCAN ;ONLY ONE THING IT CAN BE NOW
SRC2: TRNN FL,NUMF
NERROR ILC ;NOPE, LOSE
MOVEM T2,LLRCNT ;SAVE AS COUNT OF LINES TO FIND
PUSHJ P,SCAN ;GET TERMINATOR (WE HOPE)
SRC1: TRNN FL,TERMF ;ALLS WELL THAT ENDS WELL
NERROR ILC ;BUT THIS DOSNT
SRCH1A: MOVE T1,LSBUFN
MOVE T1,LSPTT(T1) ;GET POINTER TO STRINGS
PUSHJ P,CODSR ;AND GENERATE CODE
MOVE T1,LOPG ;GET SET TO HUNT IT
MOVEM T1,DPG
MOVEM T1,LLRPG ;FLAG TO SAY IF WE SHOULD PRINT PAGE
MOVE SINDEX,LOLN
PUSHJ P,FIND
TRZ FL,LINSN ;NO LINES YET
ONSRC: PUSHJ P,ONMOV ;CHECK RANGE
JRST ENDSRC ;DONE
TLZE FL,ASSMF ;FIRST TIME AND WANT .+1?
JRST [CAME T1,LOLN ;IS THERE EXACT MATCH?
JRST .+1 ;NO, THIS IS .+1
AOS SVCNT ;PRETEND WE DIDNT SEE IT
JRST SRNXT] ;AND TAKE NEXT
CAMN T1,PGMK ;PAGES ARE SPECIAL
JRST SRCPAG ;SO TAKE GOOD CARE OF THEM
MOVE T2,LSBUFN
MOVE T2,LSPTT(T2) ;POINTER TO STRINGS
PUSHJ P,COMSRC ;GO SEARCH THIS LINE
JRST SRNXT ;LOSER
MOVE T2,CPG ;GET CURRENT PAGE
CAME T2,LLRPG ;AND SEE IF WE SHOULD PRINT IT
PUSHJ P,PGPRN ;YES
MOVE T2,CPG ;NOW SET IT AS CURRENT
MOVEM T2,CPGL
MOVEM T2,LLRPG ;ALSO RESET FLAG
MOVE T2,(PNTR) ;ALSO SET LINE
MOVEM T2,CLN
TRO FL,LINSN ;WE SAW ONE
TLNN FL,DECID ;DOES HE WANT OPTION?
JRST SRNXTC ;NO, GO GET NEXT ONE OR STOP
TLNE FL,NUMSRF ;DO WE WANT ONLY LINE NUMBERS?
JRST SRCNUM ;YES
MOVE T1,PNTR ;GO PRINT LINE
PUSHJ P,OUTLIN
SRNXT1:
IFE FULDPX,<MOVEI T1,DDTINB ;READ
CALLI T1,1
LDB T1,[POINT 7,DDTINB,6] ;GET FIRST CHR
MOVEI T2,[ASCIZ /
/] ;GIVE HIM A RETURN
CALLI T2,3>
IFN FULDPX,<TTYUUO 0,T1
ANDI T1,177
TTYUUO 3,[ASCIZ /
/]>
CAIE T1,177 ;DID HE SAY RUBOUT(DO NOT USE)?
JRST LSOUT ;NO, WE'RE THROUGH
SRNXTC: SOSG LLRCNT ;HAVE WE FOUND ENOUGH
JRST LSOUT ;YES, GIVE UP (WE HAVE SEEN AT LEAST ONE)
SRNXT: PUSHJ P,FINDN ;GET NEXT LINE TO LOOK A
JRST ONSRC
SRCNUM: MOVE T1,(PNTR) ;PRINT SEQUENCE NUMBER
PUSHJ P,OUTSN
TERPRI (T1)
JRST SRNXT1 ;AND DECIDE
ENDSRC: TRZN FL,LINSN ;DID WE SEE ONE?
NERROR NLN ;NULL RANGE
JRST LSOUT
SRCPAG: AOS CPG ;JUST ADVANCE PAGE COUNTER
JRST SRNXT ;AND PROCEED
LSOUT: POP P,FL2 ;RESTORE THE FLAGS WE USED
POP P,T1
AND T1,[XWD ASSMF!NUMSRF!EXCTSR!DECID,ADDL!SUBL!CNTF]
ANDCM FL,[XWD ASSMF!NUMSRF!EXCTSR!DECID,ADDL!SUBL!CNTF]
IOR FL,T1
POP P,LOPG ;RESTORE PREVIOUS LINE NUMBERS
POP P,LOLN
POP P,HIPG
POP P,SVCNT
POP P,SVINC
MOVE T1,CLN ;LOAD CURRENT LINE AND PAGE WHICH WE FOUND
MOVE T2,CPGL
TRO FL, NUMF!PGSN ;AND MAKE LIKE SCAN SAW A NUMBER
AOS LSBUFN ;GO BACK TO SEARCH STRING ON PREVIOUS LEVEL IF ANY
POPJ P, ;AND EXIT VICTORIOUS
ASSMD1: TROA FL,CNTF ;MARK AS KEEP END OF RANGE
ASSMDT: TRZ FL,CNTF ;JUST IN CASE
TLO FL,ASSMF ;WE ASSUME .+1
MOVE T1,CLN ;SET THINGS UP FOR . TO INFINITY
MOVEM T1,LOLN
MOVEM T1,HILN ;AS GOOD AS ANYTHING WITH THE PAGE WE WILL
MOVE T1,CPGL ;USE
MOVEM T1,LOPG
TRZE FL,CNTF ;KEEP END?
JRST NOSPC ;YES
CAIE C,":" ;IF A : OR !
CAIN C,"!"
JRST HALFSP ;GET THE SECOND HALF (.+1 TO GIVEN)
MOVSI T1,377777 ;GET A LARGE PAGE
MOVEM T1,HIPG
JRST SRC4 ;BACK INTO THINGS
HALFSP: MOVEM T1,HIPG ;SET TOP AS /.
PUSHJ P,GET2HF ;GET THE SECOND HALF
JRST SRC4 ;AND GO
NOSPC: MOVE T1,LLHIPG
MOVEM T1,HIPG ;PUT BACK END
MOVE T1,LLHILN
MOVEM T1,HILN
JRST SRCH1A
LSPTR: FOR I←0,LSNUM-1
{POINT 7,LSBUF+(SRBLG/5+2)*I
}
LSPTT: FOR I←0,LSNUM-1
{LSPNT+SRNUM*I
}
BEND LSRCH
BEGIN SCAN
↑SCAN: TRZ FL,TERMF!NUMF!IDF ;RESET FLAGS
SKIPE CS,SAVCHR ;CHECK TO SEE IF WE LEFT ONE LAST TIME
JRST SL1 ;YES, IT MUST BE A DELIMITER
SKIPN C,SAVC ;BACK UP A CHARACTER?
JRST SL10 ;NO
PUSHJ P,GNCHB ;YES, GET BITS
SKIPA ;THIS STUFF HAS CORRECTED A DEFICIENCY IN THE ORIGINAL SCANNER
SL10: PUSHJ P,GNCH ;GET A CHR
SETZM SAVC
JUMPE CS,SL10 ;CHECK FOR TAB, SPACE, AND IGNORE
JUMPL CS,SL1 ;SPECIAL CHARACTER?
MOVE T3,[POINT 6,ACCUM] ;SET TO SAVE IDENT
SETZM ACCUM
TLNE CS,SNUMF⊗16 ;CHECK FOR NUMBER
JRST SNUM1 ;AND GO RACING OFF TO NUMBER ROUTINE
SL2P: TRO FL,IDF ;IT IS AN IDENT
SL2: TLNE T3,770000 ;HAVE WE STORED ENOUGH?
IDPB CS,T3 ;NO, STORE ANOTHER (RH OF CHR TABLE HAS SIXBIT)
PUSHJ P,GNCH ;CONTINUE
JUMPG CS,SL2 ;CHECK FOR ANOTHER NUMBER OR LETTER
SOK1: MOVEM CS,SAVCHR ;SAVE THE CHARACTER (MUST BE A SPECIAL CHR)
MOVEI C,0 ;ZERO IN C FOR NUMBERS AND IDENTS
POPJ P,
SL1: HRRZ C,CS ;FOR SPECIAL CHARACTERS, RETURN RH OF CTABLE
TLNE CS,TERM⊗16 ;CHECK FOR TERMINATOR
TRO FL,TERMF ;AND SET FLAG
ANDI C,377 ;GET RID OF EXTRA BITS
SETZM SAVCHR ;ZERO SAVCHR FOR LATER
CAIE C,"." ;CHECK FOR .
POPJ P, ;NO RETURN
MOVE T1,CLN ;SET UP FOR CURRENT LINE AND PAGE
MOVE T2,CPGL
TRO FL,NUMF ;CALL IT A NUMBER
POPJ P,
SNUM1: SETZB T1,T2 ;SET NUMBER ACCUMS TO 0
SN1A: TLNE T3,770000 ;WILL STORE THE SIXBIT FOR FILE NAMES
IDPB CS,T3 ;BUT ONLY IF LESS THAN 6
SN1B: LSH T1,7 ;ACCUMULATE ASCII IN T1
IOR T1,C
IMULI T2,=10 ;DECIMAL IN T2
ADDI T2,-"0"(C)
PUSHJ P,GNCH ;GET NEXT AND CONTINUE
JUMPLE CS,SOK2 ;CHECK FOR END OF NUMBER
TLNN CS,SNUMF⊗16 ;CHECK FOR NUMBER
JRST SL2P ;MUST BE AN IDENT
JRST SN1A ;CONTINUE SCANNING NUMBER
SOK2: TRO FL,NUMF ;IT WAS A NUMBER
LSH T1,1 ;CONVERT TO LINE NUMBER
IOR T1,[ASCID /00000/]
JRST SOK1 ;SAVE DELIM AND RETURN
BEND SCAN
; READ DATA LINE FOR INSERTION
BEGIN RDLIN
↑RDLIN: SETZM LIBUF+1 ;READ IN A LINE. FIRST ZERO INPUT BUFFER
MOVE T1,[XWD LIBUF+1,LIBUF+2]
BLT T1,LIBUF+MXWPL+1
MOVE T1,[POINT 7,LIBUF+1] ;SET UP POINTER
MOVEI T2,5*MXWPL-2 ;SET FOR AVAILABLE SPACE
MOVEI C,11 ;START WITH A TAB
JRST RDL3
RDL1: PUSHJ P,GNCH ;GET ANOTHER CHARACTER
CAIN C,15 ;IGNORE RETURN
JRST RDL1
CAIN C,12 ;LINE FEED IS THE ONLY PROPER END
JRST RDL2
CAIN C,200 ;ALTMODE IS A SPECIAL CASE
POPJ P, ;IT RETURNS WITHOUT MORE WORK
RDL3: IDPB C,T1 ;PUT IT IN THE BUFFER
SOJGE T2,RDL1 ;CHECK FOR OVERFLOW AND CONTINUE
RERROR LTL ;LINE IS TOO LONG
POPJ P, ;NON-SKIP RETURN
RDL2: MOVEI C,15 ;PUT IN A CR-LF
IDPB C,T1
MOVEI C,12
IDPB C,T1
HRRZS T1 ;NOW GET THE SIZE
SUBI T1,LIBUF-1
AOS (P) ;SKIP RETURN IF OK
POPJ P, ;AND RETURN
BEND RDLIN
BEGIN GNCH
↑GNCH: SOSG TIBUF+2 ;CHECK FOR BUFFER EMPTY
PUSHJ P,[TTYIN: IN TTY,0 ;GET MORE
POPJ P, ; NO PROBLEM
CLOSE TTY, ;CLEAR ALL BAD BITS
JRST TTYIN ];AND RETURN UNTIL HAVE
ILDB C,TIBUF+1 ;GET A CHR
CAIN C,175 ;CONVERT ALTMODE TO 200 TO DISTINGUISH FROM
MOVEI C,200 ;LEFT CURLY BRACKET
TRNN FL,DPYF ;IS THIS A DPY?
TLNE FL,QMODF ;NO, SHOULD WE TREAT ? SPECIALLY
JRST GNCHB ;NO
CAIN C,"?" ;SHOULD WE USE ALTERNATE CHR SET?
JRST GNCHA ;YES
↑GNCHB: JUMPE C,GNCH ;IGNORE NULLS
MOVE CS,CTBL(C) ;GET CHARACTER TABLE BITS
TLNE CS,LETF⊗16 ;CHECK TO SEE IF A LETTER
TDC C,CASEBT ;USE UPPER/LOWER INFO
POPJ P, ;NO, JUST RETURN
GNCHA: SOSG TIBUF+2 ;ALTERNATE CHR SET GET ANOTHER
PUSHJ P,TTYIN ;GET SOME MORE
ILDB C,TIBUF+1
SKIPE CTBL(C) ;NO CHANGE FOR NULL,SPACE, TAB, CRET
MOVS C,CTBL(C) ;GET THE ALTERNATE CHR FROM CHR TABLE
ANDI C,177 ;ONLY THE CHR BITS
JRST GNCHB ;GO CHECK THINGS
BEND GNCH
SUBTTL DISK FILE HANDLING ROUTINES
BEGIN FIND
;FIND-- PAGE TO FIND IS IN DPG. NUMBER TO FIND IS IN SINDEX.
;LOADS T1 WITH THE LINE NUMBER FOUND
;IF NO EXACT MATCH WILL FIND NEXT HIGHER NUMBER OR A PAGE MARK.
↑FIND: MOVE T1,DPG ;GET THE DESIRED PAGE
CAMLE T1,CPG ;IS IT GREATER THAN THE PAGE WE ARE ON
JRST FWDPG ;YES, SEARCH FORWARD FOR PAGE
CAML T1,CPG ;IS IT THE SAME AS THE CURRENT PAGE?
JRST FEQPG ;YES, JUST SEARCH FOR LINE NUMBER
SUBI PNTR,1 ;BACK UP A LITTLE (IN CASE POINTED AT PAGE MARK)
FIND1: SKIPN T1,(PNTR) ;GET THE WORD, BUT WATCH FOR START OF BUFFER
JRST FINDHD ;WILL HAVE TO FINISH COPY AND START OVER
CAME T1,PGMK ;IS IT A PAGE MARK?
SOJA PNTR,FIND1 ;CONTINUE SEARCHING
SOS T1,CPG ;DECREASE THE PAGE WE ARE NOW ON
CAME T1,DPG ;IS IT THE RIGHT ONE YET?
SOJA PNTR,FIND1 ;NO, KEEP SEARCHING
SUBI PNTR,1 ;BACK OVER PAGE MARK
FIND2: SKIPN T1,(PNTR) ;PICK UP WORD AND CHECK FOR START OF BUFFER
JRST FINDHD ;HAVE TO DO IT THE HARD WAY
TRNN T1,1 ;IS IT A SEQUENCE NUMBER?
SOJA PNTR,FIND2 ;NO, CONTINUE SEARCH
CAMN T1,PGMK ;IS IT PERHAPS A PAGE MARK?
AOJA PNTR,FNDFW1 ;YES, GO FORWARD A LINE AND RETURN IT
PUSHJ P,CHKREN ;DOES USER WANT OUT?
CAMGE SINDEX,T1 ;IS THE LINE WE WANT GREATER OR EQUAL TO THIS ONE
SOJA PNTR,FIND2 ;NO, KEEP UP THE GOOD WORK
CAMN SINDEX,T1 ;EXACT MATCH?
POPJ P, ;YES, RETURN
JRST FNDFW1 ;GO FORWARD A LINE TO GET NEXT LARGER
FEQPG: SKIPN T1,(PNTR) ;CHECK THE WORD WE ARE POINTING AT
JRST FNDFOO ;MUST BE POINTING AT END OF BUFFER OR BUFFER EMPTY
CAMN T1,PGMK ;IS IT A PAGE MARK?
SOJA PNTR,FIND2 ;MUST BE ONE AT END OF PAGE, SEARCH BACKWARDS
FEQPG1: CAMGE SINDEX,T1 ;COMPARE TO LINE WE WANT
JRST FIND2 ;WANT A SMALLER ONE, SEARCH BACK
JRST FNDFW1 ;SEARCH FORWARD
FWDPG: SKIPN T1,(PNTR) ;SEARCH FORWARD FOR PAGE
JRST FNXRCP ;END OF BUFFER, GET A NEW ONE
CAME T1,PGMK ;FOUND A PAGE MARK?
AOJA PNTR,FWDPG ;NO, CONTINUE
AOS T1,CPG ;ADVANCE CURRENT PAGE COUNT
CAME T1,DPG ;AND SEE IF WE ARE THER YET
AOJA PNTR,FWDPG ;NUTS, LOOK SOME MORE
ADDI PNTR,1 ;ADVANCE BEYOND PAGE MARK
FNDFW1:
FIND3: SKIPN T1,(PNTR) ;LOOK FOR LINE
JRST FNXRC ;END OF RECORD, GET A NEW ONE
TRNN T1,1
AOJA PNTR,FIND3 ;NOT LINE NUMBER
CAMN T1,PGMK ;PAGE MARK
POPJ P, ;RETURN IT, IT IS BEST MATCH WE CAN FIND
PUSHJ P,CHKREN ;DOES USER WANT OUT?
CAMLE SINDEX,T1 ;ARE WE THERE YET?
AOJA PNTR,FIND3 ;NO, CONTINUE SEARCH
POPJ P, ;YES, FINALLY
FNDFOO: CAMN PNTR,BUFP ;ARE WE POINTED TO START OF BUFFER
JRST FDFOO1 ;YES, BUFFER MUST BE EMPTY
SUBI PNTR,1 ;NO, MUST HAVE BEEN AT END OF BUFFER
FDFOO2: SKIPN T1,(PNTR) ;GET WORD
ERROR ICN ;MUST BE CONFUSED, THERE SHOULD BE A LINE NUMBER
TRNN T1,1 ;SEARCH FOR LINE NUMBER
SOJA PNTR,FDFOO2 ;KKEP LOOKING
CAMN T1,PGMK ;IS IT A PAGE MARK
AOJA PNTR,FNDFW1 ;YES, SEARCH FORWARD
JRST FEQPG1 ;GO DO SOMETHING WITH IT
FDFOO1: TRNE FL,EOF2 ;ARE WE AT END OF FILE?
JRST FINDHD ;WILL HAVE TO TRY FROM START
PUSHJ P,GETN ;GET THE NEXT BUFFER
JRST FEQPG
FNXRCP: TRNE FL,EOF2 ;ARE WE AT END OF FILE
JRST FNX1 ;YES, JUST RESET BGPG AND LOOK AGAIN
PUSHJ P,GETN ;GET THE NEXT BUFFER
JRST FWDPG ;AND CONTINUE SEARCH
FNX1: MOVE T1,CPG ;SET BGPG TO CURRENT PAGE
MOVEM T1,BGPG
TRO FL,BGSN ;RECORD THAT LARGEST PAGE SEEN
MOVEI T1,0 ;RETURN 0 FOR EOF
POPJ P,
FNXRC: TRNE FL,EOF2 ;ARE WE AT END OF FILE
JRST FNX1 ;YES, GIVE HIM BACK THE 0
PUSHJ P,GETN ;NO, GET THE NEXT BUFFER
JRST FIND3 ;AND CONTINUE LOOKING FOR LINE
↑FINDHD: TRNE FL,BOF ;ARE WE AT THE START OF THE FILE
JRST FNDFST ;YES, CAN NOT GO BACK JUST GIVE FIRST LINE OF FILE
TRNN FL,READOF ;DON'T BOTHER IN READ ONLY MODE
PUSHJ P,OCOMPL ;COMPLETE THE COPY
TLNE FL,COPFIL ;IS THIS A COPY
JRST FINDH4 ;YES, DON'T RELEASE IN AND OUT
RELEASE IN,0 ;RELEASE IO DEVICES
RELEASE OUT,0
INIT IN,14 ;AND GET THEM BACK
SIXBIT /DSK/
IBUF
JRST NODSK ;WHERE DID THE DISK GO, IT WAS HARE BEFORE
INIT OUT,14
SIXBIT /DSK/
XWD OBUF,0
JRST NODSK
MOVE T1,BUFHD ;SET UP JOBFF TO ESTABLISH BUFFERS
MOVEM T1,JOBFF
INBUF IN,=2
OUTBUF OUT,=2
TRNE FL,READOF ;ARE WE IN READ ONLY MODE?
JRST FINDH2 ;SET TO POINT TO ORIGINAL NAME AGAIN
MOVE T1,EDNAM
MOVEM T1,NAMO
MOVEM T1,NAMI
MOVSI T1,'TMP' ;AND EXTENSION
MOVEM T1,NAMO+1
MOVEM T1,NAMI+1
SETZM NAMO+2
SETZM NAMO+3
SETZM NAMI+3
LOOKUP IN,NAMI ;GET THAT FILE
JRST EDFLIN ;BUT IT JUST PUT ONE THERE
ENTER OUT,NAMO
JRST EDFLIN ;SOME OTHER BASTARD MUST BE USING IT
FINDH3: SETZM WC ;WC STARTS OUT 0
TRZ FL,EOF!EOF2 ;NOT AT EOF YET
TRO FL,BOF ;BUT ARE AT START OF FILE
TLO FL,FSTOPF ;SET FOR FIRST OP
TLZ FL,TECOF ;BUT NOT TECO
MOVEI T1,1 ;SET UP INPUT PAGE IN CASE OF
MOVEM T1,INPG ;ORDER OR LTL ERRORS ON INPUT
SETZM SVWD
SETZM OLDLIN ;USED IN CHECKING INPUT ORDER OF LINES
PUSHJ P,FILLBF ;FILL UP THE BUFFER
MOVEI T1,1
MOVEM T1,CPG ;START ON PAGE 1
MOVE PNTR,BUFP ;SET PNTR TO START OF WORLD
JRST FIND ;AND GO LOOKING
FNDFST: MOVE T1,@BUFP ;GET FIRST WORD
↑FNDFS1: MOVE PNTR,BUFP ;SET TO START OF WORLD
POPJ P, ;AND DISMISS
FINDH4: RELEASE ALTDV,0 ;LET GO OF ALTERNATE DEVICE
INIT ALTDV,14
SIXBIT /DSK/
ALTBF
JRST NODSK
MOVE T1,SVJRL2
MOVEM T1,JOBFF
INBUF ALTDV,2 ;ALL SET UP
FINDH2: MOVE T1,ORGNAM ;SET TO ORIGINAL NAME
MOVEM T1,NAMI
MOVE T1,ORGEXT
MOVEM T1,NAMI+1
MOVE T1,ORGPPN ;ALSO SAME PPN
MOVEM T1,NAMI+3
TLNE FL,COPFIL
JRST FINDH5
LOOKUP IN,NAMI
JRST NOFIL ;NO FKLE THERE START OVER
JRST FINDH3 ;GO ON
FINDH5: LOOKUP ALTDV,NAMI
JRST NOFIL
JRST FINDH3
BEND FIND
BEGIN FINDN
;FIND THE NEXT LINE, PAGE MARK, ETC.
↑FINDN1: SKIPN T1,(PNTR)
JRST FINDN2
TRNN T1,1
↑FINDN: AOJA PNTR,FINDN1
POPJ P, ;RETURN THE LINE
FINDN2: TRNE FL,EOF2 ;IS IT EOF?
POPJ P, ;YES, RETURN PRESENT T1 (0 FOR EOF)
PUSHJ P,GETN ;GET NEXT BUFFER
JRST FINDN1 ;GO LOOK SOME MORE
BEND FINDN
BEGIN FINDZ
FINDZ1: SKIPN T1,(PNTR) ;AS FINDN BUT STOPS AT END OF RECORD
POPJ P,
TRNN T1,1 ;LINE NUMBER?
↑FINDZ: AOJA PNTR,FINDZ1
POPJ P,
BEND FINDZ
BEGIN FINDB
;FIND THE PREVIOUS LINE
FINDB1: SKIPN T1,(PNTR) ;WATCH OUT FOR START OF BUFFER
JRST FINDB2
TRNN T1,1 ;LINE NUMBER?
↑FINDB: SOJA PNTR,FINDB1 ;TRY AGAIN
CAMN T1,PGMK ;TEST FOR PAGE MARK
SOS CPG ;NOW ON PREVIOUS PAGE
POPJ P, ;RETURN LINE NUMBER
FINDB2: TRNE FL,BOF ;AT START OF FILE?
JRST FNDFS1 ;YES, GO GET THE FIRST LINE OF FILE
MOVE T1,1(PNTR) ;GET THE FIRST LINE ON THIS PAGE
TRNN T1,1 ;MAKE SURE THERE IS ONE THERE
ERROR ICN ;NO, WE ARE CONFUSED
PUSH P,SINDEX ;SAVE (CALLER MAY NEED IT)
MOVE SINDEX,T1
SETOM NORENT ;DON'T PANIC OUT HERE.
PUSHJ P,FINDHD ;THIS WILL WORK AND WE WILL HAVE A LITTLE SPACE BEFORE
POP P,SINDEX ;GET THIS BACK
SOJA PNTR,FINDB1 ;GO LOOK BACK AGAIN
BEND FINDB
BEGIN FILLB
;CHECK TO SEE IF BUFFER TOO FULL AND DUMP IF NEEDED
↑FILLB: MOVE T1,WC ;GET WORD COUNT
FILLB3: CAMGE T1,MAXWC ;AND COMPARE WITH MAX PERMISSIBLE
POPJ P, ;OK, SO RETURN
MOVE T1,BUFP ;GET BUFFER POINTER
ADDI T1,1
FILLB1: SKIPN T2,(T1) ;FIND END OF FIRST LINE
JRST FILLB2
TRNN T2,1
AOJA T1,FILLB1
FILLB2: PUSHJ P,NOWFL ;PART OF GETN WILL DUMP AND ADJUST POINTERS
JRST FILLB ;SEE IF IN LIMITS NOW
BEND FILLB
BEGIN GETN
↑GETN: MOVE T1,WC ;GET THE NEXT BUFFER. FIND CURRENT WORD COUNT
CAMGE T1,HLFWC ;GREATER THAN HALF OF MAX POSSIBLE?
JRST FILLBF ;NO, JUST REFILL BUFFER
ASH T1,-1 ;YES, TAKE HALF OF IT
ADD T1,BUFP ;CONVERT TO POINTER
GETN1: SKIPN T2,(T1) ;LOOK FOR A WORD BOUNDARY
JRST NOWFL ;WE ARE HERE?
TRNN T2,1 ;SEQUENCE NUMBER?
SOJA T1,GETN1
↑NOWFL: PUSHJ P,DUMP ;DUMP IT
MOVE T2,T1 ;COPY POINTER
SUB T2,BUFP ;AND FIND OUT HOW MANY DUMPED
SUB PNTR,T2 ;ADJUST POINTER
EXCH T2,WC ;CALC NEW WORD COUNT
SUBB T2,WC
ADD T2,BUFP ;GET POINTER TO END OF BUFFER
HRLS T1 ;SET UP BLT
HRR T1,BUFP
BLT T1,(T2)
JRST FILLBF ;AND FINISH FILLIN BUFFER
BEND GETN
BEGIN OCOMPL
↑OCOMPL: MOVE T1,WC ;GET CURRENT WORD COUNT
ADD T1,BUFP ;TURN IT INTO A POINTER
PUSHJ P,DUMP ;DUMP DUMPS BUFFER FROM BUFP TO (T1)
SETZM WC ;TELL IT NO CURRENT WORD COUNT
TRNE FL,EOF2 ;ALL DONE?
POPJ P,
PUSHJ P,FILLBF ;FILL UP INPUT BUFFER
PUSHJ P,CHKREN ;DOES HE WANT OUT?
JRST OCOMPL ;AND GO DUMP THIS ONE TOO
BEND OCOMPL
↑CHKREN:
IFN 0,<
TLNN FL,ISCOP ;THERE ARE SOME CIRCUMSTANCES UNDER
SKIPN REENTSW ; WHICH NO ACTION SHOULD BE
POPJ P, ; TAKEN
PUSH P,T1 ;SAVE THIS DUDE
MOVEI T1,0 ;COPY IN PROGRESS IS ONE, NORENT ON
EXCH T1,NORENT ; IS ANOTHER
JUMPL T1,T1POPJ
MOVE T1,(PNTR) ;THIS LINE NUMBER
TRNE T1,1 ;IF NOT A LINE NUMBER,
CAMN T1,PGMK ; OR IF A PAGE MARK, DON'T DO IT
JRST T1POPJ ; THAT'S ABOUT ENOUGH OF THAT
SETZM REENTSW ;ONCE ONLY
MOVEM T1,CLN ;MAKE THE LINE WE STOPPED ON
MOVE T1,CPG ; INTO "./."
MOVEM T1,CPGL
OUTPUT TTY, ;FORCE OUTPUT
PUSHJ P,PGPRN ;PRINT PAGE NUMBER
MOVE T1,PNTR ;SET UP TO PRINT LINE
PUSHJ P,OUTLIN ; AND THE LINE WE STOPPED ON
OUTPUT TTY, ;FORCE OUTPUT AGAIN
TTYUUO 11,0 ;CLEAR ANY REMAINING COMMANDS OR ANYTHING
NERROR BKO ;"BREAK OUT" AND GET NEXT COMMAND
T1POPJ: POP P,T1
>
POPJ P,
BEGIN DUMP
↑DUMP: MOVE T2,BUFP ;DUMP BUFFER FROM BUFP TO (T1)
CAMGE T2,T1 ;CHECK TO SEE IF WE ARE DUMPINF ANYTHING
TRZ FL,BOF ;IF SO TURN OFF BOF
TRNN FL,READOF ;RETURN IF READ ONLY MODE
DUMP1: CAML T2,T1 ;MORE TO DO?
POPJ P, ;NO, RETURN
PUSH P,T1 ;SAVE FOR LATER
MOVEI T1,1(T2) ;FIND END OF THIS LINE
DUMP3: SKIPN T3,(T1) ;ANY OLD END WILL DO
JRST DUMP2
TRNN T3,1 ;SUCH AS A LINE NUMBER
AOJA T1,DUMP3 ;NOT YET
DUMP2: SUB T1,T2 ;GET LENGTH
CAML T1,OBUF+2 ;WILL IT FIT?
PUSHJ P,OUTDO ;NO, DUMP CURRENT BUFFER
DUMP4: MOVE T3,(T2) ;PICK UP WORD
PUSHJ P,OUTWD
ADDI T2,1 ;ADVANCE POINTER
SOJG T1,DUMP4 ;AND CHECK COUNT
POP P,T1
JRST DUMP1 ;GO CHECK FOR END
BEND DUMP
BEGIN OUTWD
↑OUTWD: SOSG OBUF+2 ;CHECK WORDS LEFT
PUSHJ P,OUTDO
OUTWD1: IDPB T3,OBUF+1 ;OUTPUT IT
POPJ P, ;AND RETURN
↑OUTDO: OUTPUT OUT,0
STATO OUT,760000 ;CHECK FOR ERRORS
POPJ P,
ERROR DDE ;YES, GIVE ERROR AND BOMB OUT
BEND OUTWD
BEGIN FILLBF
↑FILLBF: MOVE T1,WC ;GET WORD COUNT
ADD T1,BUFP ;AND CONVERT TO POINTER TO END OF BUFFER
FILBF3: CAML T1,FILPT ;FULL ENOUGH?
POPJ P, ;YES, RETURN
TLNE FL,TECOF ;SPECIAL READING FOR TECO FILES
JRST RDTECO
HRLI T1,-MXWPL-2 ;GET A COUNT FOR MAX LINE SIZE
SKIPN T3,SVWD ;SEE IF THERE IS A WORD LEFT FROM LAST TIME
PUSHJ P,GETWD ;ELSE GET A NEW ONE
JUMPE T3,SNEOF ;MUST BE EOF
TLZE FL,FSTOPF ;IF FIRST OP
JRST CKTECO ;CHECK FOR TECO FILE
NOTECO: MOVEM T3,SVWD2 ;SAVE FOR SEQUENCE CHECK
JRST FILBF4 ;GO PUT IT AWAY
FILBF1: PUSHJ P,GETWD ;ELSE GET A NEW ONE
JUMPE T3,FILBF2 ;0 WORD MUST BE EOF
TRNE T3,1 ;CHECK FOR SEQNUM
JRST FILBF2 ;YES, FINISH PUTTING IT IN
FILBF4: MOVEM T3,(T1) ;PUT IN THIS WORD
AOS WC ;AND ADVANCE WORD COUNT
AOBJN T1,FILBF1 ;ADVANCE POINTER AND CHECK COUNT
JRST INLTL ;LINE IS TOO LONG
FILBF2: MOVEM T3,SVWD ;SAVE THIS WORD
FILBF0: SETZM (T1) ;MAKE SURE OF A ZERO WORD
HRRZS T1 ;ELIMINATE COUNT INFO
MOVE T3,SVWD2 ;CHECK ON ORDER OF INPUT LINES
CAMN T3,PGMK ;WAS IT A PAGE MARK?
SETZM OLDLIN ;RESET LINE LAST INPUT
CAMG T3,OLDLIN ;CHECK FOR CORRECT ORDER
JRST OUTOFO ;LINES ARE OUT OF ORDER
FILBF5: MOVEM T3,OLDLIN ;SAVE FOR LATER
CAMN T3,PGMK ;ADVANCE INPUT PAGE
AOS INPG
SKIPE SVWD ;CHECK TO SEE IF WAS EOF
JRST FILBF3 ;AND TRY FOR MORE
SNEOF: SETZM (T1) ;MAKE SURE OF ZERO WORD
TRO FL,EOF2 ;SET EOF FLAG
MOVE T1,INPG ;GET INPUT PAGE
MOVEM T1,BGPG ;AND SET LARGEST PAGE
TRO FL,BGSN
SETZM SVWD ;ALSO ZERO EXTRA WORD
POPJ P, ;AND RETURN
INLTL: PUSHJ P,GETWD ;FIND THE END OF THE LINE ON INPUT
JUMPE T3,INLTL2 ;THIS IS IT
TRNN T3,1 ;OR MAYBE THIS
JRST INLTL ;KEEP LOOKING
INLTL2: MOVEM T3,SVWD ;SAVE IT
PUSH P,T1 ;SAVE POINTER TO END OF IT
SUBI T1,2 ;LAST PART THAT IS IN THE LINE
MOVEI T2,<BYTE (21)0(7)15,12> ;A CRLF
DPB T2,[POINT 15,(T1),35] ;MAKE SURE IT ENDS PROPERLY
INLTL1: SKIPN T2,(T1) ;NOW LOOK FOR THE START OF IT
ERROR ICN ;SOMETHING HAS GONE WRONG, THERE IS NO LINE #
TRNN T2,1 ;START?
SOJA T1,INLTL1 ;NO, TRY AGAIN
MOVE T2,INPG ;PRINT HIM THE CURRENT PAGE
PUSHJ P,PGPRN
PUSHJ P,OUTLIN ;PRINT THE LINE
RERROR LTL ;AND THE ERROR MESSAGE
POP P,T1 ;RESTORE POINTER TO END
SOS WC ;GET WORD COUNT CORRECTED
SOJA T1,FILBF0 ;AND CONTINUE FILL
OUTOFO: PUSH P,T1 ;SAVE THE POINTER
PUSH P,T3 ;SAVE T3 ALSO
SUBI T1,1 ;GET BACK INTO LINE
OUTOF1: SKIPN T2,(T1) ;LOOK FOR START OF LINE
ERROR ICN ;HORRIBLE CONFUSION
TRNN T2,1 ;CHECK FOR SEQ NUM
SOJA T1,OUTOF1 ;NOPE, TRY SOME MORE
MOVE T2,INPG ;PRINT HIM THE PAGE
PUSHJ P,PGPRN
PUSHJ P,OUTLIN ;PRINT THE LINE
RERROR ORDER ;GIVE HIM SOMETHING TO THINK ABOUT
POP P,T3 ;RESTORE
POP P,T1 ;GET SET TO GO ON
JRST FILBF5 ;GO
CKTECO: TRNE T3,1 ;CHECK FOR A LINE NUMBER
JRST NOTECO ;NO ITS NOT A TECO FILE
TLO FL,TECOF ;SET WARNING FLAG
TLNE FL,COPFIL ;IS IT ANOTHER FILE?
JRST CKTEC2 ;SPECIAL CHECK
SETSTS IN,0 ;SET FOR CHAR AT A TIME INPUT
MOVSI T3,(<POINT 7,0>)
HLLM T3,IBUF+1 ;SET INPUT BYTE POINTER
MOVEI T3,5 ;COMVERT TO CHRS
IMULM T3,IBUF+2
AOS IBUF+2 ;AND COMPENSATE FOR THINKING WE TOOK ONE
↑RDTECO:HRRZM T1,TMPT1 ;SAVE THIS FOR A WHILE
MOVEI T3,1(T1) ;ZERO OUT A FEW WORDS
HRL T3,T1
SETZM (T1)
BLT T3,MXWPL(T1)
ADDI T1,1 ;THIS IS WHERE CHRS SHOULD BE PUT
PUSH P,T1 ;SAVE
MOVE T1,SVWD ;LAST LINE NUMBER
MOVE T2,[ASCID /00100/]
PUSHJ P,ASCIAD
MOVEM T1,SVWD ;SAVE FOR LATER
MOVEM T1,SVWD2 ;AND FOR ORDER CHECK
CAMGE T1,[ASCID /00100/] ;CHECK WAR
JRST INSPG1 ;FORCE PAGE INSERT
EXCH T1,(P) ;GET OLD T1 BACK AND SAVE NUMBER
MOVEI T2,MXWPL*5-2 ;COUNT
MOVEI T3,11 ;FIRST CHR
HRLI T1,(<POINT 7,0>)
IDPB T3,T1
LINL1: PUSHJ P,GETWD ;NEXT CHR
CAIN T3,15
JRST LINL1 ;IGNORE RETURNS
CAIN T3,14
JRST IPGMK ;GO PUT IN A PAGE MARK
JUMPE T3,EOF1 ;MUST BE END OF FILE
POP P,-1(T1) ;PUT NUMBER IN PROPER PLACE
JRST LP1 ;AND READ MORE OF LINE
CLP: PUSHJ P,GETWD
LP1: CAIN T3,15 ;IGNORE RETURNS
JRST CLP
CAIE T3,0 ;FOR EOF
CAIN T3,12 ;OR LINE FEED
JRST LINFD ;GO PUT IN RETURN LINE FEED
IDPB T3,T1 ;ELSE DEPOSIT
SOJG T2,CLP ;HAVE WE RUN OUT
ADD T1,[XWD 70000,0] ;BACK UP POINTER
COMMENT/ THE ABOVE LINE WAS MODIFIED BY R. GORIN 9 MAY 1971
IT FORMERLY READ ADD T1,[XWD 700,0] ;BACK UP POINTER
IT IS CLEAR TO ME THAT THE ORIGINAL LINE DID NOT FUNCTION RIGHT
/
TLZ FL,TECOF ;USE THE ABSENCE AS A FLAG
PUSHJ P,GETWD
CAIE T3,12
JUMPN T3,.-2
LINFD: MOVEI T3,15
IDPB T3,T1
MOVEI T3,12
IDPB T3,T1
MOVEI T1,1(T1)
MOVE T3,T1
SUB T3,TMPT1 ;GET COUNT
ADDM T3,WC
TLOE FL,TECOF ;IF OFF WE HAD A LTL ERR
JRST FILBF0 ;THIS WILL FINISH UP
PUSH P,T1 ;SET UP FOR LTL CODE
AOS WC
AOS (P)
SOJA T1,INLTL1
INSPG1: POP P,T1
SKIPA
IPGMK: POP P,T2 ;GET RID OF IT
MOVEI T3,1 ;SO IT WILL NOT BE EOF
MOVEM T3,SVWD ;SO WE START OVER
MOVE T3,PGMK
MOVEM T3,SVWD2
MOVEM T3,-1(T1)
MOVEI T2,2
ADDM T2,WC
MOVE T3,[BYTE (7) 15,15,14]
MOVEM T3,(T1)
AOJA T1,FILBF0 ;DONE
EOF1: POP P,T2 ;CLEAR STACK
SOJA T1,SNEOF
BEND FILLBF
BEGIN GETWD
↑GETWD: TRNE FL,EOF
JRST RTEOF ;RETURN 0 IF EOF
TLNE FL,COPFIL ;IN A COPY, WE GET FROM SOMEWHERE ELSE
JRST COPGET
SOSG IBUF+2 ;CHECK FOR MORE WORDS
JRST GETDO ;NO, GET SOME BY INPUT
GETWD1: ILDB T3,IBUF+1 ;PICK UP A WORD
JUMPE T3,GETWD ;IGNORE 0 WORDS
POPJ P, ;RETURN
GETDO: INPUT IN,0
STATO IN,760000 ;CHECK FOR ERRORS AND EOF
JRST GETWD1
STATZ IN,740000 ;ERROR?
ERROR DIE ;YES, INPUT ERROR
TRO FL,EOF ;NO, MUST BE EOF
RTEOF: MOVEI T3,0 ;RETURN 0
POPJ P,
BEND GETWD
BEGIN ONMOV
;CHECK TO SEE IF OUT OF LIMITS SKIP RETURN IF OK
↑ONMOV: JUMPE T1,CPOPJ ;0, MUST BE EOF SO ALL DONE
PUSHJ P,CHKREN ;DOES HE WANT OUT?
MOVE T2,CPG ;GET THE CURRENT PAGE
CAMN T1,PGMK ;ARE WE AT A PAGE MARK?
ADDI T2,1 ;YES, TREAT AS NEXT PAGE
TRNE FL,CNTF ;IS THIS A ! TYPE COMMAND?
JRST ONCNT
CAMLE T2,HIPG ;HOW DOES IT COMPAGE WITH UPPER LIMIT
POPJ P, ;HIGHER, ALL DONE
CAME T1,PGMK ;IF PAGE MARK, DO NOT COMPARE LINE
CAME T2,HIPG ;OR IF NOT ON LAST PAGE
SKIPA
CAMG T1,HILN ;ARE WE OUT OF LINES?
AOS (P) ;SKIP RETURN ALL OK
POPJ P, ;GO
ONCNT: CAMN T1,PGMK ;DO NOT COUNT PAGE MARKS
SKIPG SVCNT ;IF PAGE MARK, GIVE UP IF DONE
SOSL SVCNT ;ARE WE OUT
AOS (P) ;SKIP RETURN FOR OK
POPJ P,
BEND ONMOV
BEGIN INSED
;INSERT A LINE (IN LIBUF) INTO PLACE POINTED AT BY PNTR
;WORD COUNT OF OLD LINE IN OCNT. OF NEW LINE IN NCNT
↑INSED: MOVE T1,NCNT ;SEE HOW THE COUNTS DIFFER
SUB T1,OCNT
JUMPE T1,NOBLT ;THEY ARE SAME, NO MOVING NECESSARY
JUMPG T1,BBLT ;NEW IS LARGER, BLT WILL NOT DO
MOVE T2,PNTR ;SET UP BLT POINTER FROM PNTR+OCNT
ADD T2,OCNT
HRLS T2
HRR T2,PNTR ;TO PNTR+NCNT
ADD T2,NCNT
ADDB T1,WC ;ADJUST WC TO OLD WORD COUNT +NCNT-OCNT
ADD T1,BUFP ;LAST TRANSFERED IS BUFP+WC+NCNT-OCNT
BLT T2,(T1)
NOBLT: SKIPN T1,NCNT ;CHECK FOR 0 NEW COUNT (WE ARE DELETING)
POPJ P, ;IF SO DONE
MOVE T2,PNTR ;GET THE POINTER POSITION FOR BLT
HRLI T2,LIBUF ;FROM LIBUF TO PNTR
ADD T1,PNTR ;STOP AT PNTR+NCNT-1
BLT T2,-1(T1)
POPJ P, ;AND ALL DONE
BBLT: MOVE T2,BUFP ;FAKE BACKWARDS BLT FROM BUFP+WC
ADD T2,WC
ADDB T1,WC ;TO BUFP+WC+NCNT-OCNT (ALSO FIX WC)
ADD T1,BUFP
BBLT1: CAMGE T2,PNTR ;STOP HERE (COULD STOP SOONER BUT THIS IS EASIER)
JRST NOBLT ;AND GO MOVE IN NEW STUF
MOVE T3,(T2) ;TRANSFER A WORD
MOVEM T3,(T1)
SUBI T1,1
SOJA T2,BBLT1 ;AND KEEP IT UP
BEND INSED
BEGIN GETLTH
↑GETLTH: MOVE T1,PNTR ;GET THE LENGTH OF THE LINE POINTED AT
ADDI T1,1
GETLN1: SKIPN T2,(T1) ;ANY END IS GOOD ENOUGH
JRST GETLN2
TRNN T2,1 ;SEQ-NUM?
AOJA T1,GETLN1
GETLN2: SUB T1,PNTR ;FIND LENGTH
POPJ P, ;AND RETURN
BEND GETLTH
SUBTTL TELETYPE OUTPUT ROUTINES
BEGIN OUTLIN
↑OUTLIN: TRNE FL2,SUPN ;ARE WE SUPPRESSING LINE NUMBERS?
AOS T1 ;YES, SKIP IT
HRLI T1,(<POINT 7,0>) ;GET SET TO PRINT A LINE
TRNE FL2,SUPN ;IF SUPPRESSING LINE NUMBERS
IBP T1 ;ALSO SUPPRESS THE TAB WHICH FOLLOWS
SKIPE SCRUP2 ;SCRUP OK?
SOSLE SCRUP1
JRST .+2 ;OK THIS TIME
JRST BUNKO
OUTL1: ILDB C,T1 ;GET A CHR
PUSHJ P,OCHR ;AND PRINT IT
CAIE C,12 ;IS IT LINE FEED
JRST OUTL1 ;NO, CONTINUE
OUTPUT TTY,0 ;FLUSH IT
POPJ P,
BUNKO: PUSH P,T2 ;SAVE T2 ON STACK
PUSH P,T3 ;SAVE ANOTHER
MOVE T2,T1 ;SAVE OLD POINTER
IBP T2 ;POINTER TO FIRST CHARACTER
MOVEI T3,0 ;INITIALIZE COUNT MAX 89 CHARS
BUNK1: ILDB C,T1 ;LOAD BYTE
CAIN C,11 ;IS THIS A TAB
TRO T3,7 ;TURN ME ON
CAIE C,12 ;LINE FEED STOPS ALL
AOJA T3,BUNK1 ;COUNT AND LOOP
SUBI T3,=83
MOVN T3,T3
PUSHJ P,DECBP ;DECREMENT POINTER, POINTS TO CR
CAMN T1,T2 ;ARE THESE THE SAME?
JRST BUNK3 ;ALL DONE
MOVEI C," "
SOJL T3,BUNK2 ;NO SPACES
PUSHJ P,OCHR
JRST .-2 ;LOOP
BUNK2: PUSHJ P,DECBP
LDB C,T1
PUSHJ P,OCHR
CAME T1,T2
JRST BUNK2
BUNK3: POP P,T3
POP P,T2
MOVEI C,15
PUSHJ P,OCHR
MOVEI C,12
PUSHJ P,OCHR
OUTPUT TTY,
CALLI C,22
ANDI C,37
ADDI C,10
MOVEM C,SCRUP1
POPJ P,
DECBP: ADD T1,[XWD 070000,0] ;PUSH IT BACK
SKIPG T1 ;SKIP IF OK
SUB T1,[XWD 430000,1] ;MAJIC
POPJ P,
BEND OUTLIN
PGPRN: MSSG (T3,<
PAGE >)
PUSHJ P,DPRNT ;PRINT THE NUMBER IN T2
OUTPUT TTY,0 ;FLUSH TTY OUTPUT
TERPRI (T3) ;RETURN
POPJ P,
OUTSN: MOVEM T1,SQBUF ;PUT IT IN SPACE FOLLOWED BY A TAB
IFEDUPL,<MOVEI T3,SQBUF
CALLI T3,3;> TTYUUO 3,SQBUF ;ONE OR 'TOTHER
POPJ P,
↑DECPR: IDIVI T1,=10 ;THE USUAL DECIMAL PRINTER
HRLM T2,(P)
SKIPE T1
PUSHJ P,DECPR
HLRZ C,(P)
ADDI C,"0"
JRST (T3) ;EXCEPT HAS ARBITRARY OUTPUT ROUTINE
;THE USUAL NUMBER PRINTER
DPRNT: IDIVI T2,=10
HRLM T3,(P)
SKIPE T2
PUSHJ P,DPRNT
HLRZ C,(P)
ADDI C,"0"
IFE FULDPX,<JRST OCHR>
IFN FULDPX,<TTYUUO 1,C
POPJ P,>
;INPUT IN T2, PRINTS TO TTY -- USES T1 (SIXBIT→ASCII)
SIXLJ1: JUMPE T2,SIXPRT ;NO USE IF 0
LSH T2,6 ;SHIFT NEXT CHAR IN
↑↑SIXLJP: TLNN T2,770000 ;LEFT-JUSTIFIED?
JRST SIXLJ1 ;NO, CONTINUE
↑↑SIXPRT: MOVEI T1,0
LSHC T1,6 ;GET NEXT CHAR
JUMPE T1,CPOPJ ;DONE
ADDI T1,40 ;CONVERT TO ASCII
TTYUUO 1,T1 ;PUT OUT CHAR
JRST SIXPRT
BEGIN OCHR
;CHARACTER OUTPUT
↑OCHR: MOVE CS,CTBL(C) ;GET THE MAJIC BITS
TLNE CS,LETF⊗16 ;CHECK FOR LETTER
TDC C,CASEBT ;AND CHANGE CASE AS NECESSARY
trnn fl2,supn ;is this a pretty print? if so no ? conversion.
TRNE FL,DPYF ;IS IT A DISPLAY
JRST OCH2 ;YES, JUST PRINT
PUSH P,C ;SAVE THE CHARACTER
LDB C,[POINT 7,CTBL(C),10] ;GET PRINT EQUIV.
JUMPE C,OCH1 ;NONE, PRINT ORIGINAL
TDNE CS,[XWD LETF⊗16,M37] ;IS THIS A LETTER OR SPECIAL
TRNN FL,M37F ;AND A MODEL 37
SKIPA
JRST OCH1 ;THEN PRINT NORMALLY
MOVEM C,(P) ;SAVE IN STACK
MOVEI C,"?"
SOSG TOBUF+2
OUTPUT TTY,0
IDPB C,TOBUF+1 ;OUTPUT THE CHR
OCH1: POP P,C ;GET THE CHR TO PRINT
OCH2: SOSG TOBUF+2
OUTPUT TTY,0
IDPB C,TOBUF+1
POPJ P, ;AND RETURN
BEND OCHR
SUBTTL VERY CLEVER WFW ROUTINES FOR LINE NUMBER ARITHMETIC
BEGIN ASCIAD
↑ASCIAD: AND T2,K2A ;CONVERT TO NUMBERS
IOR T1,K4A ;MAKE SURE THIS IS IN DIGIT FORM
ADD T1,K1A ;GET EACH DIGIT IN RANGE 166 TO 177 FOR CARRY
ADD T2,T1 ;SUM
AND T2,K3A ;GET RID OF 100 BITS IF THERE
MOVE T1,K4A ;FIND OUT WHICH ONES NEED SUBTRACTING
AND T1,T2
ASH T1,-3 ;CONVIENIENTLY THEY NEED 6 SUBTRACTED
SUBM T2,T1 ;SO DO IT
IOR T1,K4A ;AND RECONVERT TO DIGITS
POPJ P, ;WE HAVE ADDED THE ASCII IN T1 AND T2 RESULT IN T1
K1A: BYTE (7) 106,106,106,106,106
K2A: BYTE (7) 17,17,17,17,17
K3A: BYTE (7) 77,77,77,77,77
K4A: ASCID /00000/
K5A: BYTE (7) 7,7,7,7,7
K6A: BYTE (1) 1 (7) 77,77,77,77,77
K7A: BYTE (1) 0 (7) 106,106,106,106,106
↑ASCAV: AND T2,K2A
IOR T1,K4A ;THIS ROUTINE AVERAGES 2 ASCII NUMERS
LSH T1,-1
ADD T1,K7A ;IT WORKS MOSTLY BY MAJIC
LSH T2,-1
ADD T2,T1
AND T2,K6A
MOVE T1,T2
ANDCM T1,K3A
AND T2,K3A
MOVE T3,T2
LSH T3,-3
AND T3,K2A
AND T2,K5A
SUB T2,T3
LSH T1,-4
ADD T2,T1
LSH T1,-2
ADD T2,T1
IOR T2,K4A
POPJ P,
BEND ASCIAD
SUBTTL CHARACTER TABLE FOR SCANNER
;A CHARACTER TABLE FOR USE ON TYPE IN AND TYPE OUT
;FLAGS USED IN CHARACTER TABLE
OPF←←10 ;THIS IS A SPECIAL CHARACTER
SNUMF←←4 ;THIS IS PART OF A NUMBER
LETF←←2 ;THIS IS A LETTER
TERM←←1 ;THIS IS A TERMINATOR
M37←←400000 ;THIS CHR IS PRINTED AS ITSELF ON MODEL 37
NSEPF←←200000 ;THIS IS NOT A SEPERATOR (USED ON $,%,AND.)
DEFINE CHRS (FLAGS,PALT,INALT,RH)
<BYTE (4) FLAGS (7) PALT,INALT(18)RH>
CTBL: 0
CHRS OPF,"!","↓","↓"
CHRS OPF,42,"α","α"
CHRS OPF,"#",3,3
CHRS OPF,"$",4,4
CHRS OPF,"%",5,5
CHRS OPF,"&",6,6
CHRS OPF,"'",7,7
CHRS OPF,"(",10,10
0
CHRS OPF!TERM,0,12,12
CHRS OPF,0,13,13
CHRS OPF,0,14,14
0
CHRS OPF,")",16,16
CHRS OPF,"*",17,17
CHRS OPF,"+",20,20
CHRS OPF,{","},21,21
CHRS OPF,"-",22,22
CHRS OPF,".",23,23
CHRS OPF,"/",24,24
CHRS OPF,"0",25,25
CHRS OPF,"1",26,26
CHRS OPF,"2",27,27
CHRS OPF,"9",30,30
CHRS OPF,"6",31,31
CHRS OPF,"4",32,32
CHRS OPF,"=",33,33
CHRS OPF,"<",34,34
CHRS OPF,\">",35,35
CHRS OPF,"7",36,36
CHRS OPF,"8",37,37
0
CHRS OPF,0,1,"!"
CHRS OPF,0,2,42
CHRS OPF,0,3,"#"
CHRS OPF,0,4,"$"+NSEPF
CHRS OPF,0,5,"%"+NSEPF
CHRS OPF,0,6,"&"
CHRS OPF,0,7,47
CHRS OPF,0,10,"("
CHRS OPF,0,16,")"
CHRS OPF,0,17,"*"
CHRS OPF,0,20,"+"
CHRS OPF,0,21,{","}
CHRS OPF,0,22,"-"
CHRS OPF,0,23,"."+NSEPF
CHRS OPF,0,24,"/"
CHRS SNUMF,0,25,20
CHRS SNUMF,0,26,21
CHRS SNUMF,0,27,22
CHRS SNUMF,0,175,23
CHRS SNUMF,0,32,24
CHRS SNUMF,0,"5",25
CHRS SNUMF,0,31,26
CHRS SNUMF,0,36,27
CHRS SNUMF,0,37,30
CHRS SNUMF,0,30,31
CHRS OPF,0,174,":"
CHRS OPF,0,{";"},{";"}
CHRS OPF,0,34,"<"
CHRS OPF,0,33,"="
CHRS OPF,0,35,">"
CHRS OPF,"?","?","?"
CHRS OPF,0,140,"@"
XXZ←101
REPEAT =26,<CHRS LETF,0,XXZ+40,XXZ-40
XXZ←XXZ+1>
CHRS OPF,0,173,"["
CHRS OPF,0,"\","\"
CHRS OPF,0,175,"]"
CHRS OPF,0,"↑","↑"
CHRS OPF,0,"←","←"
CHRS OPF,100,140,140
XXZ←141
REPEAT =26,<CHRS LETF,XXZ-40,XXZ,XXZ-100
XXZ←XXZ+1>
CHRS OPF,"[",173,173+M37
CHRS OPF,":",174,174+M37
CHRS OPF,"3",175,175
CHRS OPF,{"]"},176,176+M37
CHRS OPF,"\",177,177
CHRS OPF,0,0,200
IFE STANSW,<LPTAB: REPEAT 11,<XWD 600000,.-LPTAB>
REPEAT 4,<.-LPTAB>
XWD 400000,.-LPTAB
REPEAT 22,<XWD 600000,.-LPTAB>
REPEAT 37,<XWD 400000,.-LPTAB>
XWD 600000,.-LPTAB
REPEAT 40,<XWD 400000,.-LPTAB>
REPEAT 40,<XWD 600000,.-LPTAB>>
IFN STANSW,<LPTAB: REPEAT 11,<XWD 400000,.-LPTAB>
REPEAT 4,<.-LPTAB>
REPEAT 13,<XWD 400000,.-LPTAB>
XWD 400000,137
XWD 400000,.-LPTAB
XWD 400000,136
REPEAT 45,<XWD 400000,.-LPTAB>
XWD 400000,140
REPEAT 33,<XWD 400000,.-LPTAB>
134
XWD 400000,.-LPTAB
XWD 400000,32
XWD 400000,30
XWD 400000,100
REPEAT 33,<XWD 400000,.-LPTAB>
XWD 400000,176
XWD 400000,175
XWD 400000,134
XWD 400000,174>
SUBTTL END OF SOS
XLIST ;DON'T LIST LITERALS
IFN TWOSGM,{
LIT
DEPHASE
END STPTA
;} END STPT